Question

我想循环访问Excel工作表，并根据文本文件中的唯一ID存储值。

我遇到了循环问题而且我已经对它进行了研究而没有运气，而且我当前的嵌套循环不断溢出。在修改控制变量时，它不再更新相应的单元格，而是继续存储所有32767次迭代的初始索引值。

请有人解释为什么会这样，并提供一种纠正方法吗？

Sub SortLetr_Code()
'sort columns for Letr_Code files

    Dim lr As Long

    Application.ScreenUpdating = False
    lr = Cells(Rows.Count, 1).End(xlUp).Row

    Range("A2:B" & lr).Sort key1:=Range("B2"), order1:=1

    Application.ScreenUpdating = True

    'Value of cell for example B1 starts out as X
    Dim x As Integer
    Dim y As Integer

    x = 2
    y = 2

'Cell References

    Dim rwCounter As Range
    Dim rwCorresponding As Range
    Dim rwIndexValue As Range
    Dim rwIndexEnd As Range
    Dim rwIndexStore As Range

    'Variables for files that will be created
    Dim FilePath As String
    Dim Filename As String
    Dim Filetype As String

    'Variables defined
    FilePath = "C:\Users\Home\Desktop\SURLOAD\"
    Filetype = ".dat"

    'Use Cell method for Loop
    rwIndex = Cells(x, "B").Value
    Set rwCounter = Range("B" & x)

    'Use Range method for string manipulation
    Set rwCorresponding = Range("A" & x)
    Set rwIndexValue = Range("B" & y)
    Set rwIndexStore = Range("B" & x)
    Set rwIndexEnd = Range("B:B").End(xlUp)

    'Objects for creating the text files
    Dim FileCreate As Object
    Set FileCreate = CreateObject("Scripting.FileSystemObject")

    'Object for updating the file during the loop
    Dim FileWrite As Object

    For Each rwIndexStore In rwIndexEnd.Cells
        'Get Substring of cell value in BX for the file name
        Do Until IsEmpty(rwCounter)

            Filename = Mid$(rwIndexValue, 7, 5)
            Set FileWrite = FileCreate.CreateTextFile(FilePath + Filename + Filetype)

            'Create the file
            FileWrite.Write (rwCorresponding & vbCrLf)

            Do
                'Add values to the textfile
                x = x + 1
                FileWrite.Write (rwCorresponding & vbCrLf)

            Loop While rwCounter.Value Like rwIndexValue.Value

            'Close this file
            FileWrite.Close

            y = x
        Loop
    Next rwIndexStore

End Sub

Answer 1

我没有看到你在循环中设置rwCounter的地方。

看起来它会保持在范围（“B2”）上，x会继续增加直到它遇到错误，无论是在整数还是长的限制。

在循环中的某处添加Set rwCounter = Range("B" & x)以增加它

Answer 2

这是解决方案。

Sub GURMAIL_File()
'sort columns for Letr_Code files
    Dim lr As Long

    Application.ScreenUpdating = False
    lr = Cells(Rows.Count, 1).End(xlUp).Row

    Range("A2:B" & lr).Sort key1:=Range("B2"), order1:=1

    Application.ScreenUpdating = True

    'Variables that store cell number
    Dim Corresponding As Integer
    Dim Index As Integer
    Dim Counter As Integer

    Corresponding = 2
    Index = 2
    Counter = 2

    'Cell References
    Dim rwIndexValue As Range

    'Variables for files that will be created
    Dim l_objFso As Object
    Dim FilePath As String

    Dim Total As String
    Dim Filename As String
    Dim Filetype As String
    Dim FolderName As String

    'Variables defined
    FilePath = "C:\Users\Home\Desktop\SURLOAD\"
    'Name of the folder to be created
    FolderName = Mid$(ActiveWorkbook.Name, 9, 8) & "\"
    'Folder path
    Total = FilePath & FolderName
    'File Extension
    Filetype = ".dat"

    'Object that creates the folder
    Set l_objFso = CreateObject("Scripting.FileSystemObject")

    'Objects for creating the text files
    Dim FileCreate As Object
    Set FileCreate = CreateObject("Scripting.FileSystemObject")

    'Object for updating the file during the loop
    Dim FileWrite As Object

    'Get Substring of letter code in order to name the file. End this loop once ID field is null.
    Do While Len(Range("A" & Corresponding)) > 0
        'Create the directory if it does not exist
        If Not l_objFso.FolderExists(Total) Then
            l_objFso.CreateFolder (Total)
        End If

        'Refence to cell containing a letter code
        Set rwIndexValue = Range("B" & Index)
        'Substring of that letter code
        Filename = Mid$(rwIndexValue, 7, 5)
        'Create the file using the substring and store it in the proper location
        Set FileWrite = FileCreate.CreateTextFile(Total + Filename + Filetype, True)

        'For each letter code, find the corresponding values. End the loop once the last value for the letter code is stored.
        Do While Range("B" & Index) Like Range("B" & Counter)
            'Add each line to the text file.
            FileWrite.WriteLine (Range("A" & Corresponding))

            'Incrementer variables that allow you to exit the loop
            'if you have reached the last value of the current letter code.
            Corresponding = Corresponding + 1
            Counter = Counter + 1
        Loop

        'Close the file you were writing to
        FileWrite.Close

        'Make sure that Index value is updated to the next letter code
        Index = Counter
        'In case Index value needs updating (safeguard to make sure that the new letter code is stored to index value).
        Set rwIndexValue = Range("B" & Index)

    Loop
End Sub

在Excel中循环宏

2 个答案: