VBA - 如果 A 列中的單元格 = 值，則將同一行的 B、C、D 列復制到新工作表

Question

我正在努力尋找我可以使用的任何信息。 在來這里之前，我進行了大量搜索，任何幫助將不勝感激。 我已經掌握了一些基本的 VBA，但這有點高級，甚至不知道從哪里開始。

如果 A 列中的單元格 = 值，則將源工作表的 B、C、D 列復制到新工作表的 A、B、C 列。

這是一個例子

源工作表

新建工作表

謝謝！

Answer 1

你應該更清楚地問這個問題，以便我們可以幫助你。 而且每一步都很容易。 只是不知道你真正需要什么。 你說你已經完成了一些 VBA，所以我假設你有基礎知識。 對於“A 列 = 值”部分，我假設您是在詢問該值是否包含在 A 列中的某處。 對於“將 B、C、D 列復制到新工作表上的 A、B、C 列”。 我假設您正在復制整個專欄。 以下代碼將幫助您組織您的想法，並可能讓您開始。

Sub YourMacr(ByVal compare_value)
    Dim arr As Variant, srcSheet As Worksheet, destSheet As Worksheet
    Set srcSheet = Sheets("xxxxxx")
    Set destSheet = Sheets("xxxxx")
    arr = srcSheet.Columns("A:A")
    If IsInArray(compare_value, arr) Then
        srcSheet.Columns("B:D").Copy
        destSheet.Columns("A:C").PasteSpecial xlPasteValues
    End If
End Sub

Private Function IsInArray(target As Variant, arr As Variant) As Boolean
    Dim ele As Variant
    On Error GoTo IsInArrayError:
    For Each ele In arr
        If ele = target Then
            IsInArray = True
            Exit Function
        End If
    Next ele
    Exit Function
IsInArrayError:
    On Error GoTo 0
    IsInArray = False
End Function

根據您對問題的新描述，您希望將特定行復制粘貼到新工作表，而不是將整個數據網格復制到工作表。 然后，我更喜歡使用數組來完成任務。 下面的代碼將幫助你很好。 希望這能讓你開始

Public Sub YourMacr(ByVal compare_val)
    Dim srcSheet As Worksheet, destSheet As Worksheet

    Set srcSheet = ThisWorkbook.Sheets("your source sheet name ..........")
    Set destSheet = ThisWorkbook.Sheets("your new sheet name ...........")

    'Determine the last row in the source sheet, here I assume your data is on continues range and start from row 1
    Dim lastRow As Long
    lastRow = srcSheet.Range("A1").End(xlDown).Row

    'Loop through the column A, find which rows has value wanted
    ReDim idx_arr(1 To lastRow)
    Dim cnt As Integer
    cnt = 0
    For i = 1 To lastRow
        If srcSheet.Cells(i, 1).Value = compare_value Then
            cnt = cnt + 1
            idx_arr(cnt) = i
        End If
    Next

    If cnt = 0 Then Exit Sub

    For i = 1 To cnt
        destSheet.Cells(i, "A").Value = srcSheet.Cells(idx_arr(i), "B")
        destSheet.Cells(i, "B").Value = srcSheet.Cells(idx_arr(i), "C")
        destSheet.Cells(i, "C").Value = srcSheet.Cells(idx_arr(i), "D")
    Next i

    Dim targetRows(1 To 10000)

End Sub