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

Question

如果以前曾经问过这个问题，我会道歉，但我找不到与我已经拥有的代码相匹配的解决方案，除了我正在添加的条件之外，它几乎可以工作。

说明：

我在Sheet1中有多个Record＃。 我需要在Sheet2中找到相同的匹配项，当找到它时，我需要它返回第8列和第15列中的值，这些值基于第7列中的值（以及随后的行＃）。

例如：

   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

结果将是：

123 IRABCD取消

989 APSDABC In Prog

我的代码如下：

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

我在Next i上收到"Next without For"错误

Answer 1

这就是代码的简化版本。 注意值得改变的是

1. 声明工作表变量（ ws1和ws2 ）以减少键入/读取字符串Worksheets("Sheet#")
2. 从ElseIf方法切换到使用Select Case
3. 更正了上一行计算中的一些不合格对象
4. 为清楚起见，添加了Option Explicit

在效率方面，你可能最好在循环数组而不是像这样的范围。 无论哪种方式，切换Screen Updating以加快速度都是一个好主意。

---

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

代码中有两个缺少End If 。 要避免此问题，请将End If添加为go，并填写If块内容。

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

使用代码格式化程序自动缩进代码将有助于捕获此类错误。 查看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

使用Scripting.Dictionary匹配唯一值比使用嵌套循环快得多。 观看： Excel VBA简介第39部分 - 词典 。

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

硬编码

硬编码？ 这意味着使用工作表的代码名称，因此您只需编写例如Sheet1.Name，Sheet2.Rows.Count等。您可以在VBE（F11）中找到代码名称。 单击工作表时，属性窗口会在第一行显示（名称）属性，您也可以在其中更改它。 但有趣的是，您可以根据需要通过工作表选项卡重命名工作表，代码仍然有效。

您应该始终在模块中的任何代码之前使用Option Explicit ，因为它将指示代码中是否存在错误。

在数字和字符串的过程 （Sub或Function）开头使用常量 ，这样您就可以轻松找到它们，如果要更改它们，您只需要执行一次 。 想象一下，您不会再使用第15列中的数据，而是来自第12列的数据。您必须在代码中多次更改它，但使用常量只需更改一次 。

由于我不知道列中的内容，我使用了一些通用变量名，但是你应该总是使用更具描述性的名称，如intSource，lngData，objWbSource，objWsTarget，rngValues，intCount等。

使用With ... End With语句尤其适用于工作表，不仅不必多次键入其名称，而且可以使代码在其他人或自己（例如数月或数年）之后更具可读性 。

在此代码中使用另一种方法（使用Find方法）确定最后使用的行 ，唯一的区别是例如.Cells（Rows.Count，1）.End（xlUp）.Row的首选方式，它赢了如果你有数据，请跳过最后一行。

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