在另一个工作表列中搜索第一个工作表列名称，然后插入该列数据

Question

我有2个工作簿，即工作簿A和工作簿B

工作簿的列按A，B，C，D顺序排列，而B工作簿的列按D，C，B，A顺序排列。

我必须在适当的列中将A工作簿数据插入到B工作簿中，即在A，B在B，C在C，C在D在D的适当列A中插入的列

我尝试了以下代码

  Sub DEMO()
   For i = 1 To 4
      For j = 2 To 4
        For k = 2 To 4
          If Sheets(1).Cells(i, j).Value = Sheets(2).Cells(i, j).Value Then
          Sheets(2).Cells(k, j).Value = Sheets(1).Cells(j, i).Value

    End If
    Next k
    'MsgBox Sheets(1).Cells(2, 1).Value
    'MsgBox Sheets(2).Cells(2, 1).Value
Next j
Next i
End Sub

请对此提供帮助

Answer 1

匹配…的列名

工作表A

列名在…

工作表B

使用循环和WorksheetFunction.Match method

Option Explicit

Sub MatchColumns()
    Dim wsA As Worksheet 'define worksheet A
    Set wsA = ThisWorkbook.Worksheets("A")

    Dim ColsRangeA As Range 'get column names in A
    Set ColsRangeA = wsA.Range("A1", wsA.Cells(1, wsA.Columns.Count).End(xlToLeft))

    Dim wsB As Worksheet 'define worksheet B
    Set wsB = ThisWorkbook.Worksheets("B")

    Dim ColsRangeB As Range 'get column names in B
    Set ColsRangeB = wsB.Range("A1", wsB.Cells(1, wsB.Columns.Count).End(xlToLeft))

    Dim MatchedColNo As Long

    Dim Col As Range
    For Each Col In ColsRangeA 'loop throug column names in A
        MatchedColNo = 0 'initialize
        On Error Resume Next 'test if column name can be found in worksheet B column names
        MatchedColNo = Application.WorksheetFunction.Match(Col.Value, ColsRangeB, False)
        On Error GoTo 0

        If MatchedColNo <> 0 Then 'if name was found
            wsB.Cells(2, MatchedColNo).Value = "Matches wsA col " & Col.Column
        Else 'if name didn't match
            MsgBox "no maching column found for " & Col.Value
        End If
    Next Col
End Sub

Answer 2

在标题下方复制

代码

'*******************************************************************************
'Purpose:     Copies the values below headers from one worksheet
'             to another containing the same headers.
'*******************************************************************************
Sub CopyBelowHeaders()

    ' !!! Header List !!! Change this to any comma separated string containing
    ' the values of the headers e.g. "ID, Product,Count, Price,Stock ".
    Const cHeaders As String = "A,B,C,D"
    Const cSource As String = "Sheet1"    ' Source Worksheet Name
    Const cTarget As String = "Sheet2"    ' Target Worksheet Name
    Const cFirstR As Long = 2             ' First Row Number

    Dim rngS As Range     ' Current Source Header Cell Range,
                          ' Current Source Column Last Used Cell Range,
                          ' Current Source Column Range
    Dim rngT As Range     ' Current Target Header Cell Range,
                          ' Current Target Column Range
    Dim vntH As Variant   ' Header Array
    Dim vntS As Variant   ' Source Header Column Array
    Dim vntT As Variant   ' Target Header Column Array
    Dim i As Long         ' Header Arrays Element Counter

    vntH = Split(cHeaders, ",")       ' Write Header List to Header Array.
    ReDim vntS(UBound(vntH)) As Long  ' Resize Source Header Column Array.
    ReDim vntT(UBound(vntH)) As Long  ' Resize Target Header Column Array.

    ' Column Numbers to Column Arrays
    ' In Source Worksheet
    With ThisWorkbook.Worksheets(cSource)
        ' Loop through elements of Header Array.
        For i = 0 To UBound(vntH)
            ' In Source Row Range (Header Row, 1st Row)
            With .Rows(1)
                ' Find current element (string) of Header Array
                ' in Source Row Range.
                Set rngS = .Find(Trim(vntH(i)), .Cells(.Cells.Count), _
                        xlValues, xlWhole, xlByRows, xlNext)
                ' When current element was found, write column number to
                ' Source Header Columns Array.
                If Not rngS Is Nothing Then vntS(i) = rngS.Column
            End With
        Next
    End With
    ' In Target Worksheet
    With ThisWorkbook.Worksheets(cTarget)
        ' Loop through elements of Header Array.
        For i = 0 To UBound(vntH)
            ' In Target Row Range (Header Row, 1st Row)
            With .Rows(1)
                ' Find current element (string) of Header Array
                ' in Target Row Range.
                Set rngT = .Find(Trim(vntH(i)), .Cells(.Cells.Count), _
                        xlValues, xlWhole, xlByRows, xlNext)
                ' When current element was found, write column number to
                ' Source Header Columns Array.
                If Not rngS Is Nothing Then vntT(i) = rngT.Column
            End With
        Next
    End With

    ' Source Worksheet to Target Worksheet
    ' In Source Worksheet
    With ThisWorkbook.Worksheets(cSource)
        ' Loop through elements of Source Array.
        For i = 0 To UBound(vntS)
            ' When current element of Source Header Column Array and current
            ' element of Target Header Column Array are different than "".
            If vntS(i) > 0 And vntT(i) > 0 Then
                ' Find Last Used Cell Range in current Source Column Range.
                Set rngS = .Columns(vntS(i)).Find("*", , xlFormulas, _
                        xlWhole, xlByColumns, xlPrevious)
                ' When current Source Column is not empty.
                If Not rngS Is Nothing Then
                    ' When current Source Column contains data in at least
                    ' one more row than the Source Header row.
                    If rngS.Row > 1 Then
                        ' Calculate Source Column Range.
                        Set rngS = .Range(.Cells(cFirstR, vntS(i)), rngS)
                        ' In First Cell of Target Column Range
                        With ThisWorkbook.Worksheets(cTarget) _
                                .Cells(cFirstR, vntT(i))
                            ' Clear contents in Target Column Range from
                            ' First Cell to bottom cell.
                            .Resize(Rows.Count - cFirstR + 1).ClearContents
                            ' Resize Current Target Column Range to the size
                            ' of Current Source Column Range.
                            Set rngT = .Resize(rngS.Rows.Count)
                        End With
                        ' Copy values from Current Source Column Range to
                        ' Current Target Column Range.
                        rngT = rngS.Value
                    End If
                End If
            End If
        Next
    End With
End Sub