Microsoft VBA Excel 提取相同名称的整列数据

问题场景

简述：

比较Sheet2的标题行中的每个变量名称与Sheet1中的标题行的变量名称。如果找到匹配的变量名称，它会从Sheet1中复制该变量名称所在列的数据到Sheet2中对应的列。

代码描述

vb 复制代码

Sub CopyDataBasedOnHeaders()
    Dim wsSource As Worksheet, wsDestination As Worksheet
    Dim lastRowSource As Long, lastRowDestination As Long
    Dim lastColSource As Integer, lastColDestination As Integer
    Dim headerRow As Integer
    Dim iColSource As Integer, iColDestination As Integer
    Dim matchFound As Boolean

    ' 设置工作表和标题行
    Set wsSource = ThisWorkbook.Sheets("Sheet1")
    Set wsDestination = ThisWorkbook.Sheets("Sheet2")
    headerRow = 1 ' 标题行是第一行

    ' 获取源和目标工作表的最后一列
    lastColSource = wsSource.Cells(headerRow, wsSource.Columns.Count).End(xlToLeft).Column
    lastColDestination = wsDestination.Cells(headerRow, wsDestination.Columns.Count).End(xlToLeft).Column

    ' 循环通过目标工作表的每一列标题
    For iColDestination = 1 To lastColDestination
        matchFound = False
        ' 在源工作表中搜索匹配的标题
        For iColSource = 1 To lastColSource
            If wsSource.Cells(headerRow, iColSource).Value = wsDestination.Cells(headerRow, iColDestination).Value Then
                ' 如果找到匹配的标题，复制数据
                matchFound = True
                lastRowSource = wsSource.Cells(wsSource.Rows.Count, iColSource).End(xlUp).Row
                lastRowDestination = wsDestination.Cells(wsDestination.Rows.Count, iColDestination).End(xlUp).Row + 1
                ' 从第二个单元格开始复制到最后一个有值的单元格
                wsSource.Range(wsSource.Cells(2, iColSource), wsSource.Cells(lastRowSource, iColSource)).Copy
                ' 粘贴到目标工作表的相应列
                wsDestination.Cells(lastRowDestination, iColDestination).PasteSpecial Paste:=xlPasteValues
                Application.CutCopyMode = False
                Exit For
            End If
        Next iColSource
        
        ' 如果没有找到匹配的标题，给出提示
        If Not matchFound Then
            MsgBox "Header " & wsDestination.Cells(headerRow, iColDestination).Value & " not found in Sheet1", vbExclamation
        End If
    Next iColDestination
End Sub

对照组

第一步

如果单元格的值在第1行内存在相同的值，则输出第1行内单元格的列数和行数，例如A1的相同值出现在S1，则输出S1。

excel 复制代码

=IFERROR(CELL("address", INDEX('Sheet1!1:1', MATCH('Sheet2!A2', 'Sheet1!1:1', 0))), "No Match")

下面分别解释每个函数的作用：

MATCH函数：MATCH(A1, 1:1, 0)
- MATCH函数搜索特定值在一个区域内的相对位置。在这个例子中，它搜索第1行中与A1单元格中值相同的单元格的位置。
- A1是MATCH函数的查找值，即第1行中搜索的值。
- 1:1是MATCH函数的查找数组，指定了搜索范围仅限于第1行。
- 0表示精确匹配，即MATCH函数只会返回完全匹配A1单元格值的单元格位置。
INDEX函数：INDEX(1:1, MATCH(A1, 1:1, 0))
- INDEX函数返回指定数组中特定位置的值。在这个例子中，它被用来返回第1行中特定位置的单元格引用。
- 1:1是INDEX函数的数组参数，指定是第1行。
- MATCH(A1, 1:1, 0)给出了INDEX函数的行号参数（在这种情况下是列号，因为数组是单行的），表示在第1行中与A1单元格值相匹配的单元格的位置。
CELL函数：CELL("address", INDEX(1:1, MATCH(A1, 1:1, 0)))
- CELL函数返回关于单元格格式、位置或内容的信息。在这个例子中，使用CELL函数来获取单元格的地址。
- "address"是CELL函数的第一个参数，它告诉CELL函数想要获取的信息类型是单元格的地址。
- INDEX(1:1, MATCH(A1, 1:1, 0))是CELL函数的第二个参数，它提供了想要获取地址的单元格引用。

整个公式的执行流程如下：

首先，MATCH函数找出A1单元格的值在第1行中的位置。
接着，INDEX函数使用这个位置来获取相应的单元格引用。
最后，CELL函数使用这个单元格引用来返回单元格的地址。

如果MATCH函数没有找到相应的值，它会返回一个错误。

第二步

取出第一步产生的结果中的列名，例如 $AF$ 1，AF才是想要的。以下是一个使用MID和SEARCH函数组合提取列字母的例子：

excel 复制代码

=SUBSTITUTE(LEFT(A1, FIND("$", A1, 2)-1), "$", "")

对于A2单元格中的列字母，可以在B2单元格中使用相同的公式：

excel 复制代码

=SUBSTITUTE(LEFT(A2, FIND("$", A2, 2)-1), "$", "")

公式的工作原理如下：

FIND("$", A1, 2)查找单元格A1中第二个"$"的位置。
LEFT(A1, FIND("$", A1, 2)-1)返回字符串的左侧部分，直到第二个"$"之前的所有字符。
SUBSTITUTE(..., "$", "")将结果中的"$"替换为空字符串，只留下列字母。

第三步

要从Sheet1中根据列坐标提取数据到Sheet2：

在选定的单元格中输入以下公式：
- 如果使用Microsoft Excel：=Sheet1!AW:AW
- 如果使用Google Sheets：=Sheet1!AW:AW
使用相同的方法，将公式应用于Sheet3中的其他列，以提取Sheet1中相应的数据列。确保在每个公式中正确引用Sheet1中的列坐标。