VBA循环无法正常工作

Sub Button2_Click() Dim i As Integer, q As Integer i = 2 q = 2 Do While i < 468 And q < 3450 If Worksheets("Sheet1").Range("A" & i).Value = Worksheets("Sheet2").Range("A" & q).Value Then If Len(Worksheets("Sheet1").Cells(i, 4)) < 12 Then Dim edate As String, adate As String, ed As String, ad As String, n As Integer, x As Integer, y As Integer edate = Sheets("sheet1").Cells(i, 4).Value adate = Sheets("sheet2").Cells(q, 2).Value ed = Right(Sheets("sheet1").Cells(i, 4), 4) ad = Right(Sheets("sheet2").Cells(q, 2), 4) n = CInt(ad) - CInt(ed) If InStr(edate, "Fall") And InStr(adate, "Fall") Then x = 7 + (5 * n) If InStr(edate, "Fall") And InStr(adate, "Spring") Then x = 9 + (5 * (n - 1)) If InStr(edate, "Spring") And InStr(adate, "Spring") Then x = 9 + (5 * n) If InStr(edate, "Spring") And InStr(adate, "Fall") Then x = 12 + (5 * n) y = x - 1 Worksheets("Sheet1").Cells(i, x).Value = Worksheets("Sheet2").Cells(q, 5).Value Worksheets("Sheet1").Cells(i, y).Value = Worksheets("Sheet2").Cells(q, 3).Value i= i +1 q=2 Else i = i + 1 q = 2 End If Else If q < 3423 Then q = q + 1 else i = 1 + 1 q=2 End If Else i = i + 1 q = 2 End If End If Loop End Sub 

嘿家伙，上面的代码是我一直在处理从sheet2到sheet1重要的一些数据。 工作表2在第1列中有项目Id编号，第2列中的项目（颁发date），第3列中的奖励types以及第5列中的项目数量。第1列中的项目编号为第1列，项目编号为第4列中的项目编号。第2页有学期给予的奖项和项目ID索引，我想重要的数据，并把它们放在由文本中间的if语句给出的列。

此代码的目标是循环访问表1 A列中的项目ID号，并检查它们是否存在于表2列A中，然后导入奖励types和按入场年数差异sorting的金额date在工作表1和授予date在工作表2。date有spring/秋天和一年，所以我试着左（string，＃）命令只有几年减去，然后上述如果instr代码块应该平衡在学期的差异。

在工作表2中有相同工程ID的倍数，所以我需要代码在工作表2上的前一行之后继续循环，直到工作表1上的每个工程ID都被交叉引用为止。

有人可以指出我的代码中的错误？ 当我点击命令button时没有任何反应。

问题出在第一个if语句中，当我知道至less有450个数据匹配时，它跳过了所有需要满足条件的操作。

刚刚编辑我的代码，它现在仍在运行。

编辑列表感谢评论：固定逻辑陈述问题，固定范围/单元格/单元格问题，固定循环问题，固定的右/左string问题

Answer 1

我可以build议你重构你的代码如下：

 Sub Button2_Click() Dim i As Integer, q As Integer 'Storing the ids in an array will make it much faster to access instead 'of interfacing with Excel's object model a couple of million times Dim ids1, ids2 Dim origCalcMode As XlCalculation 'Switch off ScreenUpdating to improve speed Application.ScreenUpdating = False 'Switch off auto calculation to improve speed origCalcMode = Application.Calculation Application.Calculation = xlCalculationManual ids1 = Application.Transpose(Worksheets("Sheet1").Range("A2:A467").Value) ids2 = Application.Transpose(Worksheets("Sheet2").Range("A2:A3422").Value) 'Using For loops rather than manually keeping track of row counters 'makes the code MUCH cleaner and less prone to errors For i = 2 To 467 'Moving this test to earlier in the code avoids having to iterate 'through all the rows on Sheet2 when there is nothing that can be 'done with the matching data anyway If Len(Worksheets("Sheet1").Cells(i, 4)) < 12 Then For q = 2 To 3422 If ids1(i - 1) = ids2(q - 1) Then Dim edate As String, adate As String, ed As String, ad As String, n As Integer, x As Integer, y As Integer edate = Sheets("sheet1").Cells(i, 4).Value adate = Sheets("sheet2").Cells(q, 2).Value ed = Right(Sheets("sheet1").Cells(i, 4), 4) ad = Right(Sheets("sheet2").Cells(q, 2), 4) n = CInt(ad) - CInt(ed) If InStr(edate, "Fall") And InStr(adate, "Fall") Then x = 7 + (5 * n) If InStr(edate, "Fall") And InStr(adate, "Spring") Then x = 9 + (5 * (n - 1)) If InStr(edate, "Spring") And InStr(adate, "Spring") Then x = 9 + (5 * n) If InStr(edate, "Spring") And InStr(adate, "Fall") Then x = 12 + (5 * n) y = x - 1 Worksheets("Sheet1").Cells(i, x).Value = Worksheets("Sheet2").Cells(q, 5).Value Worksheets("Sheet1").Cells(i, y).Value = Worksheets("Sheet2").Cells(q, 3).Value Exit For End If Next End If Next 'Restore application settings Application.ScreenUpdating = True Application.Calculation = origCalcMode End Sub 

我不确定Exit For线路。 您的问题意味着如果存在，您需要处理来自Sheet2的多个条目。 如果是这样，删除Exit For行，但这将增加运行时间，因为它将需要迭代Sheet1中的每一行Sheet2中的所有3421行。

编辑：包含对ScreenUpdating和Calculation的更改，如BruceWayne所build议的。

Answer 2

感谢所有的帮助，这里是代码，以防万一有人遇到类似的问题。

这段代码循环遍历整数为1的sheet1和整数为q的sheet2，以在两个表的第一个/ A列中查找匹配项。 由于我在A列的sheet2上有多个项目创意（表1列A），它在sheet2上的行（q）处find一个匹配项后继续。 然后这继续通过指定数量的行（i），然后遍历每个i的所有行（q）。

 Public CalcState As Long Public EventState As Boolean Public PageBreakState As Boolean Sub OptimizeCode_Begin() Application.ScreenUpdating = False EventState = Application.EnableEvents Application.EnableEvents = False CalcState = Application.Calculation Application.Calculation = xlCalculationManual PageBreakState = ActiveSheet.DisplayPageBreaks ActiveSheet.DisplayPageBreaks = False End Sub Sub OptimizeCode_End() ActiveSheet.DisplayPageBreaks = PageBreakState Application.Calculation = CalcState Application.EnableEvents = EventState Application.ScreenUpdating = True End Sub Sub Button2_Click() Dim i As Integer, q As Integer, origCalcMode As XlCalculation i = 3 q = 2 Call OptimizeCode_Begin Do While i < 467 If Len(Worksheets("Sheet1").Cells(i, 4)) < 12 Then If Worksheets("Sheet1").Cells(i, 1).Value = Worksheets("Sheet2").Cells(q, 1).Value Then Dim edate As String, adate As String, ed As String, ad As String, n As Integer, x As Integer, y As Integer edate = Sheets("sheet1").Cells(i, 4).Value adate = Sheets("sheet2").Cells(q, 2).Value ed = Right(Sheets("sheet1").Cells(i, 4), 4) ad = Right(Sheets("sheet2").Cells(q, 2), 4) n = CInt(ad) - CInt(ed) If InStr(edate, "Fall") And InStr(adate, "Fall") Then x = 7 + (5 * n) If InStr(edate, "Fall") And InStr(adate, "Spring") Then x = 9 + (5 * (n - 1)) If InStr(edate, "Spring") And InStr(adate, "Spring") Then x = 9 + (5 * n) If InStr(edate, "Spring") And InStr(adate, "Fall") Then x = 12 + (5 * n) y = x - 1 Worksheets("Sheet1").Cells(i, x).Value = Worksheets("Sheet2").Cells(q, 5).Value Worksheets("Sheet1").Cells(i, y).Value = Worksheets("Sheet2").Cells(q, 3).Value q = q + 1 Else If q < 1236 Then q = q + 1 Else i = i + 1 q = 2 End If End If Else i = i + 1 q = 2 End If Loop Call OptimizeCode_End End Sub