2

問題：

2 つのタブを持つ 1 つの Excel シートがあります タブ 1 = 出荷パッケージ タブ 2 = 一括更新手順

  1. タブ 2 の列 B のすべての値を 1 つずつ確認したいと思います。
  2. タブ 2 の各行を確認しながら、タブ 2 の列 C と D の値を選択してコピーします。
  3. 選択してコピーした後、タブ1の列Gでタブ2の列Bの対応する値を見つけたい.
  4. 一致が見つかった場合は、タブ 1 の列 E (一致が見つかった行) を選択し、そこにタブ 2 からコピーした値を貼り付けます。

これまでのところ、これは私が持っているコードです。ただし、検索される値はハードコーディングされています。タブ 2 では値の数が増えているため、コードを維持するのは困難です。最適化したい。私はいくつかの可能な解決策をグーグルで検索しました。しかし、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

解決：

プライベート サブ 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

サブ終了

4

2 に答える 2

1

最適化のために、select ステートメント、activate ステートメントなどを避けることができます。以下のコードを確認してください。

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
于 2013-08-02T05:41:16.790 に答える
0

簡単な 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 を修正する必要があります

最後に、これは常に一致することを前提としています。そうでない場合、これらの厄介な値を取り除きたい場合は、式を次のよう#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))

それが役立つことを願っています。

于 2013-08-05T09:37:37.187 に答える