Question

问题：

我有1张带2个标签的Excel表格标签1 =装运包裹选项卡2 =批量更新步骤

我想逐个浏览标签2的B栏中的所有值。
当我浏览标签2中的每一行时，我将选择并复制标签2的C和D列中的值。
选择并复制后，我想在标签1栏G中找到标签2列B的相应值。
如果找到匹配项，我将选择选项卡1的E列（在找到匹配项的行中），然后粘贴从选项卡2复制的值。

到目前为止，这是我所拥有的代码。但是，搜索的值是硬编码的。随着表2中数值的增加，代码很难维护。我想优化它。我用Google搜索了几种可能的解决方案。但是在声明或设置2张纸的范围时，我会继续收到这些运行时错误。这是我的代码。

Private Sub btn_Updt_Steps_Click()
    Dim lastRow As Long
    With Sheets("Shipment Package")
    .Activate
        lastRow = .Range("G65000").End(xlUp).Row

    For i = 1 To lastRow
        If (InStr(1, .Range("G" & i).Value, "Code 001", vbTextCompare) > 0) Then
            Sheets("Mass Update Steps").Activate
            ActiveSheet.Range("C4:D4").Select
            Selection.Copy
            Sheets("Shipment Package").Activate
            .Range("E" & i).Select
            ActiveSheet.Paste

        ElseIf (InStr(1, .Range("G" & i).Value, "Code 002", vbTextCompare) > 0) Then
            Sheets("Mass Update Steps").Activate
            ActiveSheet.Range("C5:D5").Select
            Selection.Copy
            Sheets("Shipment Package").Activate
            .Range("E" & i).Select
            ActiveSheet.Paste

        ElseIf (InStr(1, .Range("G" & i).Value, "Code 003", vbTextCompare) > 0) Then
            Sheets("Mass Update Steps").Activate
            ActiveSheet.Range("C6:D6").Select
            Selection.Copy
            Sheets("Shipment Package").Activate
            .Range("E" & i).Select
            ActiveSheet.Paste

        End If

    Next

End With

NotFoundErr:
    Debug.Print "value not found"
End Sub

解决方案：

Private Sub btn_Updt_Steps_Click（）

Dim i As Long
Dim j As Long
Dim Tab2ColC As String
Dim Tab2ColD As String
Dim Tab1ColE As String
Dim Tab1ColF As String

Tab1 = "Shipment Package"
Tab2 = "Mass Update Steps"

With Worksheets(Tab1)
     LastRowTab1 = .Cells(.Rows.Count, "G").End(xlUp).Row 'LastRowInColumn(2, Tab1)
End With

With Worksheets(Tab2)
     LastRowTab2 = .Cells(.Rows.Count, "B").End(xlUp).Row 'LastRowInColumn(2, Tab2)
End With


For i = 4 To LastRowTab2

    Tab2ColumnB = Trim(Sheets(Tab2).Range("B" & i).Value)
    Sheets(Tab2).Activate
    If Tab2ColumnB <> "" Then
        Tab2ColC = "C" & i
        Tab2ColD = "D" & i
        ActiveSheet.Range(Tab2ColC, Tab2ColD).Copy

        For j = 16 To LastRowTab1
            Tab1ColumnG = Trim(Sheets(Tab1).Range("G" & j).Value)

            If Tab1ColumnG = Tab2ColumnB Then
                Sheets(Tab1).Activate
                Tab1ColE = "E" & j
                Tab1ColF = "F" & j
                Sheets(Tab1).Range(Tab1ColE, Tab1ColF).Select
                ActiveSheet.Paste
            End If

        Next
    End If

Next

End Sub

Answer 1

为了优化，您可以避免使用select语句，激活语句等。请检查以下代码。

For i = 1 To lastRow
    Application.ScreenUpdating = False
    If YourCondn1 Then
        Sheets("Mass Update Steps").Range("C4:D4").Copy
        Sheets("Shipment Package").Range("E" & i).PasteSpecial xlPasteAll
    ElseIf YourCondn2 Then
        Sheets("Mass Update Steps").Range("C5:D5").Copy
        Sheets("Shipment Package").Range("E" & i).PasteSpecial xlPasteAll
    ElseIf YourCondn3 Then
        Sheets("Mass Update Steps").Range("C6:D6").Copy
        Sheets("Shipment Package").Range("E" & i).PasteSpecial xlPasteAll
    End If
    Application.ScreenUpdating = True
Next

添加您需要的代码。希望这会奏效。我没有测试过。请检查。

Private Sub btn_Updt_Steps_Click()
    'Finding LastRow in Tab 2
    Tab1 = "Shipment Package"
    Tab2 = "Mass Update Steps"
    With Worksheets(Tab2)
        LastRowTab2 = .Cells(.Rows.Count, 2).End(xlUp).Row 'LastRowInColumn(2, Tab2)
    End With
    MatchFound = 0
    For i = 1 To LastRowTab2
        'checking whether value in tab2 column b is same as tab1 column g
        Tab2ColumnB = Trim(Sheets(Tab2).Range("B" & i).Value)
        Tab1ColumnG = Trim(Sheets(Tab1).Range("G" & i).Value)
        If Tab2ColumnB = Tab1ColumnG Then
            Tab2ColumnC = Trim(Sheets(Tab2).Range("C" & i).Value)
            Tab2ColumnD = Trim(Sheets(Tab2).Range("D" & i).Value)
            Sheets(Tab1).Range("E" & i).Value = Tab2ColumnC
            Sheets(Tab1).Range("F" & i).Value = Tab2ColumnD
            MatchFound = MatchFound + 1
        End If
    Next
    If MatchFound = 0 Then
        MsgBox "No matches found"
    ElseIf MatchFound > 0 Then
        MsgBox MatchFound & " matches were found."
    End If
End Sub

Answer 2

我认为您可以使用简单的Excel公式实现您想要的效果。

在Shipment Package中，在E1和F1中输入以下内容，然后向下拖动公式：

E1 = VLOOKUP(G1,'Mass Update Steps'!$B$1:$D$20,2,0)
F1 = VLOOKUP(G1,'Mass Update Steps'!$B$1:$D$20,3,0)

注意 - 你需要修改$ B $ 1：$ D $ 20，具体取决于你在Mass Update中有多少数据

最后，假设总是匹配。如果没有，并且您想要摆脱那些讨厌的#N/A值，那么用ISNA更新表格，例如

E1 = IF(ISNA(VLOOKUP(G1,'Mass Update Steps'!$B$1:$D$4,2,0)),"",VLOOKUP(G1,'Mass Update Steps'!$B$1:$D$4,2,0))

希望有所帮助。

如何优化查看2个工作表的宏代码

2 个答案: