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