在Excel中循环macros

我想通过Excel工作表进行循环，并将基于唯一ID的值存储在文本文件中。

我有麻烦的循环，我已经做了研究，没有运气，我目前的嵌套循环不断溢出。 当控制variables被修改时，不是更新相应的单元格，而是继续存储所有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里面的rwCounter的地方。

看起来它会停留在范围（“B2”），并且x会继续增加，直到遇到一个错误，无论是在整数还是长整数的极限。

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

Answer 2

这是解决scheme。

 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