將工作簿值組合到單個列中

Question

我有一個任務，我有兩個工作簿，一個源和一個目標。 任務是在目標工作簿中的列中搜索包含特定字符串的值。 找到后，我必須在某個列中搜索源工作簿以找到匹配的字符串。 然后，我從源工作簿的同一行中的其他 2 列中獲取值，將它們組合起來，然后將它們寫入目標工作簿中的一個單元格。

問題是值被寫入目標工作簿中的錯誤行，如下所示： example1Broken

什么時候應該是這樣的： example2proper

這是我目前的 vba：

Sub CombineWorkbooks()
    Dim var As Variant
    Dim col As Variant
    Dim i As Long
    Dim Cell As Range
    Dim wbSource As Workbook
    Set wbSource = Workbooks.Open(Filename:="CopyFromWorkbookSource.xlsx", UpdateLinks:=3)
    Dim wbDest As Workbook
    Set wbDest = Workbooks.Open(Filename:="CopyFromWorkbookDest.xlsm", UpdateLinks:=3)
    Dim address As Variant
    Dim newAddressRow As Variant
    Dim sourceVal1 As Variant
    Dim sourceVal2 As Variant
'Dest wb number column that contains the search query
    Dim sourceCol As Integer
    sourceCol = 1
    wbDest.Activate
'col = Split(ActiveCell(1).address(1, 0), "$")(0)
    For i = 1 To Rows.Count
        var = Cells(i, sourceCol).Value
        If var Like "*WI*" And Not IsEmpty(Cells(i, sourceCol).Value) Then
            wbSource.Activate
            Set Cell = Nothing
            Set Cell = Selection.Find(What:=var, LookIn:=xlValues)
            If Cell Is Nothing Then
' MsgBox "Nothing"
            Else
'We found a match!
                MsgBox "Found hit for " & var & ": " & Cell.address
'This is where the value was found in the source workbook
                address = Cell.address
'This is where the new value must go in the dest workbook NOTE the column letter must change!
                newAddressRow = Split(address, "$A$")(1)
'Get the cell values from the source wb
                sourceVal1 = Cells(newAddressRow, 2)
                sourceVal2 = Cells(newAddressRow, 3)
                MsgBox "SourceVal1: " & sourceVal1 & " SourceVal2: " & sourceVal2 & " Newaddressrow: " & newAddressRow & " i: " & i
'Activate the dest workbook for pasting
                wbDest.Activate
'Write the source wb values into a single cell in the dest wb
                Cells(i, 2).Value = sourceVal1 & Chr(10) & sourceVal2
            End If
        End If
        Next i
    End Sub
    

Answer 1

考慮刪除地址變量並使用找到的 Cell 的 Row 參數設置 sourceVals。 還可以考慮直接引用工作簿和工作表而不是激活； 見下文。

  Sub CombineWorkbooks()

    Dim i As Long
    Dim Cell As Range
    Dim wbSource As Workbook
    Dim wbDest As Workbook
    Dim sourceCol As Integer 'Destwb number column that contains the search query

    Set wbSource = Workbooks.Open(Filename:="CopyFromWorkbookSource.xlsx", UpdateLinks:=3)
    Set wbDest = Workbooks.Open(Filename:="CopyFromWorkbookDest.xlsm", UpdateLinks:=3)
    sourceCol = 1
  
    ' start at 2 to dodge the header
    For i = 2 To wbDest.Sheets(1).Rows.Count
      'this conditional can be removed if all non-header rows will contain WI
        If wbDest.Sheets(1).Cells(i, sourceCol).Value Like "*WI*" Then

          Set Cell = wbSource.Sheets(1).UsedRange.Find(What:=wbDest.Sheets(1).Cells(i, sourceCol).Value, LookIn:=xlValues)

          If Not Cell Is Nothing Then
           'We found a match!
           'Write the source wb values into a single cell in the dest wb
           Cells(i, 2).Value = wbSource.Sheets(1).Cells(Cell.Row, 2) & Chr(10) & wbSource.Sheets(1).Cells(Cell.Row, 3)
         End If
      End If
    Next i
  End Sub