Нужна помощь в копировании / вставке в Excel VBA из одной книги в другую - PullRequest
0 голосов
/ 12 ноября 2018

Мне нужно выяснить, как написать некоторый базовый код, который будет брать значение каждой ячейки (которое будет идентификатором) из выбранного диапазона, затем сопоставлять его с ячейкой в ​​главной рабочей книге, копировать всю строку указанной ячейки,затем вставьте его в исходный документ вместо идентификационного номера.Вот кикер: некоторые идентификационные номера могут совпадать с несколькими элементами, и все элементы с таким номером должны быть вставлены обратно в документ.Вот пример:

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

Я бы выбрал ячейки, содержащие 2 и 3 в Рабочей книге, что после запуска кода даст мне следующее:

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

Вот что я собираюсь сделатьпока что, но это полный беспорядок.Единственное, что ему удалось успешно сделать, - это сохранить выбранный диапазон в книге, в которую я хочу вставить.Это не скомпилируется после этого, потому что я не очень понимаю синтаксис в 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

Буду очень признателен всем, кто сможет помочь мне указать верное направление.Благодаря.

1 Ответ

0 голосов
/ 13 ноября 2018

Я укушу, вы можете использовать выходной массив для заполнения любого диапазона на любом листе.

enter image description here

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
...