excel - 自动填充找到的列中的值

Question

我试图在工作表中按名称查找两列，即。列“水果”和列“蔬菜”，然后尝试将这些列的合并值粘贴到新列中。

表“水果蔬菜”

	一个	乙	C
1	新列	水果	蔬菜
2	空白的	苹果	菠菜
3	空白的	橙子	卷心菜

工作表“ FruitsVege ”中的所需结果

	一个	乙	C
1	新列	水果	蔬菜
2	苹果菠菜	苹果	菠菜
3	橙白菜	橙子	卷心菜

我的代码

Sub Merge_B&C()
Dim WrkBk1 As Workbook
Dim WrkBk2 As Workbook
Set WrkBk2 = ActiveWorkbook
Set WrkBk1 = ThisWorkbook
Dim ws2 As Worksheet
Set ws2 = WrkBk2.Sheets(1)
    Dim xRg As Range
    Dim xRgUni As Range
    Dim xFirstAddress As String
    Dim xStr As String
    On Error Resume Next
    
    
    
    ' Insert a column in the beginning
  ws2.Columns("A:A").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    
'Search for Fruits Column
    xStr = "Fruits"
    Set xRg = ws2.Range("A1:CA1").Find(xStr, , xlValues, xlWhole, , , True)
    If Not xRg Is Nothing Then
        xFirstAddress = xRg.Address
        Do
            Set xRg = ws2.Range("A1:CA1").FindNext(xRg)
            If xRgUni Is Nothing Then
                Set xRgUni = xRg
            Else
                Set xRgUni = Application.Union(xRgUni, xRg)
            End If
        Loop While (Not xRg Is Nothing) And (xRg.Address <> xFirstAddress)
    End If
    

'Search for Vegetables Column

Dim xRg1 As Range
    Dim xRgUni1 As Range
    Dim xFirstAddress1 As String
    Dim xStr1 As String

    xStr1 = "Vegetables"
    Set xRg1 = ws2.Range("A1:CA1").Find(xStr1, , xlValues, xlWhole, , , True)
    If Not xRg1 Is Nothing Then
        xFirstAddress = xRg1.Address
        Do
            Set xRg1 = ws2.Range("A1:CA1").FindNext(xRg1)
            If xRgUni1 Is Nothing Then
                Set xRgUni1 = xRg1
            Else
                Set xRgUni1 = Application.Union(xRgUni1, xRg1)
            End If
        Loop While (Not xRg1 Is Nothing) And (xRg1.Address <> xFirstAddress)
    End If
    
    
'Select A2
   ws2.Range("A2").Select

'Write A2 = B2&C2 and Autofill
With ws2.Range("a2", Range("a" & Rows.Count).End(xlUp))
        .FormulaR1C1 = "=RC[xRgUni.Offset(1, 0)]&RC[xRgUni1.Offset(1, 0)]"
        End With

        
End Sub

我试过的是这个，但它只粘贴值，我不能自动填充整列！如果有人能让我走上正轨，那就太好了。谢谢你。

ws2.Range("A2").Value = ((xRgUni.Offset(1, 0).Value) & (xRgUni1.Offset(1, 0).Value))

标签： excelvba

Answer 1

这是一个大纲方法，希望你能适应。

Sub x()
  
Dim r1 As Range, r2 As Range

Columns("A:A").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

With Rows(1)
    Set r1 = .Find(What:="Fruits", Lookat:=xlWhole, MatchCase:=False, SearchFormat:=False)
    Set r2 = .Find(What:="Vegetables", Lookat:=xlWhole, MatchCase:=False, SearchFormat:=False)
    If Not r1 Is Nothing And Not r2 Is Nothing Then
        Range("A2:A" & Cells(Rows.Count, r1.Column).End(xlUp).Row).Formula = "=" & r1.Offset(1).Address(0, 0) & " & " & r2.Offset(1).Address(0, 0)
       'hyphen below
       'Range("A2:A" & Cells(Rows.Count, r1.Column).End(xlUp).Row).Formula = "=" & r1.Offset(1).Address(0, 0) & " & ""-"" & " & r2.Offset(1).Address(0, 0)
    End If
End With
     
End Sub