VBA循环无法正常运行

Question

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栏中有项目编号，在第2栏中有术语（授予），在第3栏中有奖励类型，在第5栏中有金额。表格1在第1栏中有项目编号，在第4栏中有期限（录入日期）。表格2的奖励由学期授予，并由项目ID索引。我想重要的是将数据放置在文本中间的if instr语句给出的列中。

此代码的目的是循环浏览工作表1列A中的项目ID号，并检查它们是否存在于工作表2列A中，然后导入奖励类型和金额（按条目之间的年数差异排序）第1页上的日期和第2页上的授予日期。日期有春季/秋季和一年，所以我尝试了left（string，＃）命令，只减去了几年，然后如果指令代码为应该平衡学期的差异。

工作表2中有多个相同的项目ID，因此我需要代码来恢复工作表2的上一行之后的循环，直到工作表1中的每个项目ID被交叉引用为止。

有人可以指出我的代码中的错误吗？ 单击命令按钮没有任何反应。

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

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

多亏了评论，编辑列表：固定逻辑陈述问题，固定范围/单元格/单元格问题，固定循环问题，固定右/左字符串问题

Answer 1

我可以建议您按以下方式重构代码：

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行。

编辑：包括对BruceWayne建议的ScreenUpdating和Calculation的更改。

Answer 2

感谢您提供的所有帮助，如果有人遇到类似问题，请使用以下代码。

该代码循环遍历具有整数i的sheet1和具有整数q的sheet2，以在两个工作表的第一/ A列中找到匹配项。 由于我在A列的sheet2上有多个项目构想（Sheet 1列A），因此在sheet2上的行（q）找到匹配项之后，它会继续。 然后，这将继续执行指定数量的行（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