在 Excel VBA 中需要帮助 copy/pasting 从一个工作簿到另一个工作簿

Question

我需要了解如何编写一些基本代码，从 selected 范围中获取每个单元格的值（这将是一个 ID 号），然后将其与主工作簿中的单元格匹配, 复制所述单元格的整行，然后将其插入到原始文档中以代替 ID 号。问题来了：某些 ID 号可能与多个项目匹配，所有具有该编号的项目都必须重新插入到文档中。这是一个例子：

Master Document              Workbook
A   B   C   D                A   B   C   D
1   a   ab  ac               2
2   b   bc  bd               3
2   b   be  bf               
3   c   cd  de

我会 select 工作簿中包含 2 和 3 的单元格，在运行之后代码会给我这个：

Workbook
A   B   C   D
2   b   bc  bd
2   b   be  bf               
3   c   cd  de

这是我目前所做的，但一团糟。它成功完成的唯一一件事是将 selected 范围存储在我要粘贴到的工作簿中。它不会编译过去，因为我不太了解 VBA:

中的很多语法

Sub NewTest()
Dim rng As Range
Dim FirstRow As Range
Dim CurrentCol As String
Dim FirstRowVal As Integer
Dim CurrentColVal As Variant
Dim rngOffset As Range

CurrentCol = "Blah"
Set FirstRow = Application.InputBox("Select the row containing your first raw material", Type:=8)
FirstRowVal = FirstRow.Row

Set rng = (Application.InputBox("Select the cells containing your IC numbers", "Obtain Materials", Type:=8))
Set rngOffset = rng.Offset(0, FirstRowVal)
CurrentColVal = rng.Column

Call CopyPaste

End Sub

Sub CopyPaste()
Dim Blah As Range
Set x = Workbooks.Open("Workbook Path")
Workbooks.Open("Workbook Path").Activate


Set y = Workbooks.Open("Master Path")
Workbooks.Open("Master Path").Activate

With x
For Each Cell In rng
x.Find(rng.Cell.Value).Select
If Selection.Offset(0, -1) = Selection Then
Selection.EntireRow.Copy
Selection = Selection.Offset(0, -1)
Else
Selection.EntireRow.Copy
Blah = Selection
End If
Workbooks.Open("Workbook Path").Activate
Sheets("Formula Sheet").Select
Blah.Insert (rng.Cell)
End

Sheets("sheetname").Cells.Select
Range("A1").PasteSpecial
'Sheets("sheetname").PasteSpecial
.Close
End With

With x
.Close
End With
End Sub

非常感谢任何能帮助我指明正确方向的人。谢谢。

Answer 1

我会咬，你可以使用输出数组填充任何工作表上的任何范围。

Sub FindAndMatch()

    Dim arrMatchFrom() As Variant, arrMatchTo() As Variant, arrOutput() As Variant
    Dim i As Integer, j As Integer, counter As Integer

    counter = 0

    arrMatchFrom = Range("A2:D6")
    arrMatchTo = Range("G2:G3")

    For i = LBound(arrMatchTo, 1) To UBound(arrMatchTo, 1)
        For j = LBound(arrMatchFrom, 1) To UBound(arrMatchFrom, 1)
            If arrMatchTo(i, 1) = arrMatchFrom(j, 1) Then
                counter = counter + 1
                ReDim Preserve arrOutput(4, counter)
                arrOutput(1, counter) = arrMatchTo(i, 1)
                arrOutput(2, counter) = arrMatchFrom(j, 2)
                arrOutput(3, counter) = arrMatchFrom(j, 3)
                arrOutput(4, counter) = arrMatchFrom(j, 4)

            End If
        Next
    Next

    For i = 1 To counter
        For j = 1 To 4
            Debug.Print arrOutput(j, i)
            Cells(9 + i, j) = arrOutput(j, i)
        Next
    Next

End Sub

在 Excel VBA 中需要帮助 copy/pasting 从一个工作簿到另一个工作簿

Need help copy/pasting in Excel VBA from one workbook to another

excel

copy

range

paste