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

VBA-如果A列中的单元格=值，然后将同一行的B，C，D列复制到新工作表

1 个答案: