在Excel中循環宏

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

這是解決方案。

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 

Answer 2

我看不到你正在設置的地方rwCounter在循環內。

它看起來會保持在範圍內（「B2」），並且x會繼續增加，直到它遇到一個錯誤，無論是在整數還是長整數的極限處。

添加Set rwCounter = Range("B" & x)某處你的循環中，以增加它