VBA代码中的多个IF语句，用于根据另一列从多个列中提取不同的单元格值。

Question

Apologies if this has been asked before, but I couldn't find a solution that matched the code I already have, which nearly works except for the conditions I'm adding in.

Explanation:

I have multiple Record #s in Sheet1. I need to find a match for the same in Sheet2 and when located, I need it to return values that are all found in Column 8 and 15, based on the value (and subsequently row #) in Column 7.

For ex:

   Sheet1:
        Column 1 
        123
        999
        989

Sheet2:
Column1   Column7   Column8      Column 15
321        PRA      PRAABC       Completed
123        IRA      IRABCD       Cancelled
000        TPSD     TPSDRST      Completed
989        APSD     APSDABC      In Prog

So the results would be:

123 IRABCD Cancelled

989 APSDABC In Prog

My code below:

Sub CopyBasedonSheet1()

Dim i As Long
Dim j As Long
Sheet1LastRow = Worksheets("Sheet1").Range("O" & Rows.Count).End(xlUp).Row
Sheet2LastRow = Worksheets("Sheet2").Range("B" & Rows.Count).End(xlUp).Row

    For j = 1 To Sheet1LastRow
        For i = 1 To Sheet2LastRow
            If Worksheets("Sheet1").Cells(j, 15).Value = Worksheets("Sheet2").Cells(i, 2).Value Then 'if Engagement # from sheet1 matches sheet2

                    If Worksheets("Sheet2").Cells(i, 7) = "IRA" Then
                        Worksheets("Sheet1").Cells(j, 23).Value = Worksheets("Sheet2").Cells(i, 8).Value 
                        Worksheets("Sheet1").Cells(j, 24).Value = Worksheets("Sheet2").Cells(i, 15).Value
                    If Worksheets("Sheet2").Cells(i, 7) = "TPSD" Then
                        Worksheets("Sheet1").Cells(j, 25).Value = Worksheets("Sheet2").Cells(i, 8).Value
                        Worksheets("Sheet1").Cells(j, 26).Value = Worksheets("Sheet2").Cells(i, 15).Value
                    ElseIf Worksheets("Sheet2").Cells(i, 7) = "CA" Then
                        Worksheets("Sheet1").Cells(j, 27).Value = Worksheets("Sheet2").Cells(i, 8).Value
                        Worksheets("Sheet1").Cells(j, 28).Value = Worksheets("Sheet2").Cells(i, 15).Value

            Else
            End If
    Next i
Next j
End Sub

I receive a "Next without For" error on Next i

Answer 1

This is what a simplified version of your code may look like. Note worthy changes are

1. Declaring worksheet variables ( ws1 & ws2 ) to reduce the number of times you have to type/read the string Worksheets("Sheet#")
2. Switched from ElseIf method to use Select Case
3. Corrected some unqualified objects on your last row calculation
4. Added Option Explicit for clarity

When it comes to efficiency, you would probably be better off looping through an array rather a range like this. Either way, it's a good idea to toggle of Screen Updating to speed things along.

---

Option Explicit

Sub CopyBasedonSheet1()

Dim ws1 As Worksheet: Set ws1 = ThisWorkbook.Sheets("Sheet1")
Dim ws2 As Worksheet: Set ws2 = ThisWorkbook.Sheets("Sheet2")

Dim i As Long, j As Long
Dim LRow1 As Long, LRow2 As Long

LRow1 = ws1.Range("O" & ws1.Rows.Count).End(xlUp).Row
LRow2 = ws2.Range("B" & ws2.Rows.Count).End(xlUp).Row

For j = 1 To LRow1
    For i = 1 To LRow2
        If ws1.Cells(j, 15).Value = ws2.Cells(i, 2).Value Then
            Select Case ws2.Cells(i, 7)
                Case "IRA"
                    ws1.Cells(j, 23).Value = ws2.Cells(i, 8).Value
                    ws1.Cells(j, 24).Value = ws2.Cells(i, 15).Value
                Case "TPSD"
                    ws1.Cells(j, 25).Value = ws2.Cells(i, 8).Value
                    ws1.Cells(j, 26).Value = ws2.Cells(i, 15).Value
                Case "CA"
                    ws1.Cells(j, 27).Value = ws2.Cells(i, 8).Value
                    ws1.Cells(j, 28).Value = ws2.Cells(i, 15).Value
            End Select
        End If
    Next i
Next j

End Sub

Answer 2

There are two missing End If s in the code. To avoid this problem, add the End If s as your go and fill in the If block content after.

 If Worksheets("Sheet1").Cells(j, 15).Value = Worksheets("Sheet2").Cells(i, 2).Value Then End If 

Using a code formatter to auto indent your code will help catch such errors. Check out RubberDuck .

Sub CopyBasedonSheet1()

    Dim i As Long
    Dim j As Long
    Sheet1LastRow = Worksheets("Sheet1").Range("O" & Rows.Count).End(xlUp).row
    Sheet2LastRow = Worksheets("Sheet2").Range("B" & Rows.Count).End(xlUp).row

    For j = 1 To Sheet1LastRow
        For i = 1 To Sheet2LastRow
            If Worksheets("Sheet1").Cells(j, 15).Value = Worksheets("Sheet2").Cells(i, 2).Value Then    'if Engagement # from sheet1 matches sheet2
                If Worksheets("Sheet2").Cells(i, 7) = "IRA" Then
                    Worksheets("Sheet1").Cells(j, 23).Value = Worksheets("Sheet2").Cells(i, 8).Value
                    Worksheets("Sheet1").Cells(j, 24).Value = Worksheets("Sheet2").Cells(i, 15).Value
                    If Worksheets("Sheet2").Cells(i, 7) = "TPSD" Then
                        Worksheets("Sheet1").Cells(j, 25).Value = Worksheets("Sheet2").Cells(i, 8).Value
                        Worksheets("Sheet1").Cells(j, 26).Value = Worksheets("Sheet2").Cells(i, 15).Value
                    ElseIf Worksheets("Sheet2").Cells(i, 7) = "CA" Then
                        Worksheets("Sheet1").Cells(j, 27).Value = Worksheets("Sheet2").Cells(i, 8).Value
                        Worksheets("Sheet1").Cells(j, 28).Value = Worksheets("Sheet2").Cells(i, 15).Value

                    Else

                    End If
                End If
            End If
        Next i
    Next j
End Sub

Using a Scripting.Dictionary to match unique values is vastly faster then using nested loops. Watch: Excel VBA Introduction Part 39 - Dictionaries .

Sub RefactoredCopyBasedonSheet1()
    Dim dic As Object, key As Variant, row As Range
    Dim r As Long

    Set dic = CreateObject("Scripting.Dictionary")

    With Worksheets("Sheet2")
        For r = 1 To .Range("B" & Rows.Count).End(xlUp).row
            key = .Cells(r, "B").Value
            Set dic(key) = .Rows(r)
        Next
    End With

    With Worksheets("Sheet1")
        For r = 1 To .Range("O" & Rows.Count).End(xlUp).row
            key = .Cells(r, "O").Value
            If dic.Exists(key) Then
                Set row = dic(key)
                Select Case row.Cells(1, 7)
                    Case "IRA"
                        .Cells(j, 23).Value = row.Cells(1, 8).Value
                        .Cells(j, 24).Value = row.Cells(1, 15).Value
                    Case "TPSD"
                        .Cells(j, 25).Value = row.Cells(1, 8).Value
                        .Cells(j, 26).Value = row.Cells(1, 15).Value
                    Case "CA"
                        .Cells(j, 27).Value = row.Cells(1, 8).Value
                        .Cells(j, 28).Value = row.Cells(1, 15).Value
                End Select
            End If
        Next
    End With
End Sub

Answer 3

Hard Coded

Hard Coded? It means code names of the sheets are used so you just write eg Sheet1.Name, Sheet2.Rows.Count etc. You can find the code name in the VBE (F11). When you click on a sheet, the properties window shows in the first row the (name) property, where you can also change it. But the interesting part is you can rename your sheets via sheet tab as you wish and the code will still work.

You should always use Option Explicit before any code in a module, because it will indicate if there is an error in the code.

Use constants at the beginning of a procedure (Sub or Function) for Numbers and Strings, so you will easily find them and if you want to change them, you will only have to do it once . Imagine you don't won't the data from column 15 anymore but data from column 12. You would have to change it many times in your code but by using constants you change it only once .

Since I don't know what's in the columns, I've used some generic variable names, but you should always use more descriptive ones like intSource, lngData, objWbSource, objWsTarget, rngValues, intCount etc.

Use the With ... End With statement especially for worksheets, not only to not have to type their name many times, but to make the code more readable for others or for yourself after eg months or years.

Another way (using the Find Method) of determining the last used row was used in this code, the only difference being to the preferred way of eg .Cells(Rows.Count, 1).End(xlUp).Row, that it won't skip the last row if you have data in it.

Option Explicit

Sub CopyBasedonSheet1()

  ' Columns in Sheet1
  Const cInt1_1 As Integer = 15   ' O
  Const cInt1_2 As Integer = 23   ' W
  Const cInt1_3 As Integer = 24   ' X
  Const cInt1_4 As Integer = 25   ' Y
  Const cInt1_5 As Integer = 26   ' Z
  Const cInt1_6 As Integer = 27   ' AA
  Const cInt1_7 As Integer = 28   ' AB
  ' Columns in Sheet2
  Const cInt2_1 As Integer = 2    ' B
  Const cInt2_2 As Integer = 7    ' G
  Const cInt2_3 As Integer = 8    ' H
  Const cInt2_4 As Integer = 15   ' O

  Const cStrSearch1 As String = "IRA"
  Const cStrSearch2 As String = "TPSD"
  Const cStrSearch3 As String = "CA"

  Dim lngLR1 As Long  ' Sheet1 Last Used Row
  Dim lngLR2 As Long  ' Sheet2 Last Used Row
  Dim lng1 As Long    ' Sheet1 Row Counter
  Dim lng2 As Long    ' Sheet2 Row Counter

  ' Sheet2
  With Sheet2
    ' Last Row Sheet2
    lngLR2 = .Range(.Cells(1, cInt2_1), .Cells(Rows.Count, cInt2_1)) _
        .Find(What:="*", After:=.Cells(1, cInt2_1), _
        LookIn:=xlFormulas, Lookat:=xlWhole, _
        SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Row
  End With

  ' Sheet1
  With Sheet1

    ' Last Row Sheet1
    lngLR1 = .Range(.Cells(1, cInt1_1), .Cells(Rows.Count, cInt1_1)) _
        .Find(What:="*", After:=.Cells(1, cInt1_1), _
        LookIn:=xlFormulas, Lookat:=xlWhole, _
        SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Row

    For lng1 = 1 To lngLR1
      For lng2 = 1 To lngLR2
          ' Check if Engagement # from Sheet1 matches Sheet2
          If .Cells(lng1, cInt1_1).Value = Sheet2.Cells(lng2, cInt2_1).Value _
            Then
            Select Case Sheet2.Cells(lng2, cInt2_2).Value
              Case cStrSearch1
                .Cells(lng1, cInt1_2).Value = Sheet2.Cells(lng2, cInt2_3).Value
                .Cells(lng1, cInt1_3).Value = Sheet2.Cells(lng2, cInt2_4).Value
              Case cStrSearch2
                .Cells(lng1, cInt1_4).Value = Sheet2.Cells(lng2, cInt2_3).Value
                .Cells(lng1, cInt1_5).Value = Sheet2.Cells(lng2, cInt2_4).Value
              Case cStrSearch3
                .Cells(lng1, cInt1_6).Value = Sheet2.Cells(lng2, cInt2_3).Value
                .Cells(lng1, cInt1_7).Value = Sheet2.Cells(lng2, cInt2_4).Value
              Case Else
            End Select
           Else
          End If
      Next
    Next

  End With

End Sub