将列标题从一张表映射到另一张表

Question

我想将列从一个工作表映射到另一个工作表，这是我尝试过的代码：

Dim x As Integer
x = 2
Do Until Sheets("Sheet1").Range("A" & x).Value = ""
Sheets("Sheet2").Range("C" & x).Value = Sheets("Sheet1").Range("A" & x).Value
x = x + 1
Loop
x = 2
Do Until Sheets("Sheet1").Range("B" & x).Value = ""
Sheets("Sheet2").Range("A" & x).Value = Sheets("Sheet1").Range("B" & x).Value
x = x + 1
Loop
x = 2
Do Until Sheets("Sheet1").Range("C" & x).Value = ""
Sheets("Sheet2").Range("B" & x).Value = Sheets("Sheet1").Range("C" & x).Value
x = x + 1
Loop

在 worksheet1 中我有：

  A                 B            C 
1 applicationname applicationid number 
2 applcation1          1          123 
3 applcation2          2          454 
4 applcation3          3          897

在 worksheet2 中我得到：

  A                 B            C 
1  appid           num        appname              
2   1              123        applcation1          
3   2              454        applcation2          
4   3              897        applcation3 

问题是还有很多其他列，这段代码似乎很长..我需要循环以便 applicationid 映射到 appid 等等..我想知道是否有一种方法可以根据标题（第一行中的数据），如果我也想复制空单元格，谁能告诉我该怎么做？ 我可以知道我是否可以有一个像界面说 sheet3 这样的工作表，我可以在其中填写所需的映射，如

     A                       B
 1   Application Name        App Name
 2   Application ID          AppID
 3   Technology              Tech
 4   Business Criticality    Bus Criticality
 5   IT Owner                IT Owner
 6   Business Owner    BusOwner                                                            and accordingly map them?thanks in advance

Answer 1

试试这个：

Sub Map()

    Dim Sh1 As Worksheet, Sh2 As Worksheet
    Dim HeadersOne() As String
    Dim HeadersTwo() As String

    With ThisWorkbook
        Set Sh1 = .Sheets("Sheet1") 'Modify as necessary.
        Set Sh2 = .Sheets("Sheet2") 'Modify as necessary.
    End With

    HeadersOne() = Split("applicationname,applicationid,number", ",")
    HeadersTwo() = Split("appname,appid,num", ",")

    For HeaderIter = 1 To 3
        SCol = GetColMatched(Sh1, HeadersOne(HeaderIter - 1))
        TCol = GetColMatched(Sh2, HeadersTwo(HeaderIter - 1))
        LRow = GetLastRowMatched(Sh1, HeadersOne(HeaderIter - 1))

        For Iter = 2 To LRow
            Sh2.Cells(Iter, TCol).Value = Sh1.Cells(Iter, SCol).Value
        Next Iter
    Next HeaderIter

End Sub

Function GetLastRowMatched(Sh As Worksheet, Header As String) As Long
    ColIndex = Application.Match(Header, Sh.Rows(1), 0)
    GetLastRowMatched = Sh.Cells(Rows.Count, ColIndex).End(xlUp).Row
End Function

Function GetColMatched(Sh As Worksheet, Header As String) As Long
    ColIndex = Application.Match(Header, Sh.Rows(1), 0)
    GetColMatched = ColIndex
End Function

如果这有帮助，请告诉我们。

后续编辑：

这是一种设置界面的方法。

假设您的设置与我的相似...

表 1：

Sheet2（我故意弄乱了标题）：

界面表：

运行代码后的结果：

这是代码。 进行相应修改并确保您的标题准确无误。

Sub ModdedMap()

    Dim Sh1 As Worksheet, Sh2 As Worksheet, Sh3 As Worksheet
    Dim HeadersOne As Range, HeadersTwo As Range
    Dim hCell As Range

    With ThisWorkbook
        Set Sh1 = .Sheets("Sheet1") 'Modify as necessary.
        Set Sh2 = .Sheets("Sheet2") 'Modify as necessary.
        Set Sh3 = .Sheets("Interface") 'Modify as necessary.
    End With

    Set HeadersOne = Sh3.Range("A1:A" & Sh3.Range("A" & Rows.Count).End(xlUp).Row)

    Application.ScreenUpdating = False

    For Each hCell In HeadersOne

        SCol = GetColMatched(Sh1, hCell.Value)
        TCol = GetColMatched(Sh2, hCell.Offset(0, 1).Value)
        LRow = GetLastRowMatched(Sh1, hCell.Value)

        For Iter = 2 To LRow
            Sh2.Cells(Iter, TCol).Value = Sh1.Cells(Iter, SCol).Value
        Next Iter

    Next hCell

    Application.ScreenUpdating = True

End Sub

Function GetLastRowMatched(Sh As Worksheet, Header As String) As Long
    ColIndex = Application.Match(Header, Sh.Rows(1), 0)
    GetLastRowMatched = Sh.Cells(Rows.Count, ColIndex).End(xlUp).Row
End Function

Function GetColMatched(Sh As Worksheet, Header As String) As Long
    ColIndex = Application.Match(Header, Sh.Rows(1), 0)
    GetColMatched = ColIndex
End Function

Answer 2

在这种情况下，无需一次复制一个单元格。不是出于任何性能原因（除非您拥有大量数据，否则您可能不会遇到任何性能问题） - 只是如果您在每列一次操作中将列直接从 Sheet1 复制到 Sheet2，代码会更简单。

第一步是确定 Sheet1 中要复制的总行数。关于如何在 Excel 中获取已使用的行数有很多观点，但最简单的可能是在工作表上使用表达式 UsedRange.Rows.Count（我们减去 1，因为我们没有复制标题行）：

Dim row_count As Long

row_count = Sheets("Sheet1").UsedRange.Rows.Count - 1
Range("Sheet1!A2").Resize(row_count).Copy Range("Sheet2!C2")
Range("Sheet1!B2").Resize(row_count).Copy Range("Sheet2!A2")
Range("Sheet1!C2").Resize(row_count).Copy Range("Sheet2!B2")

我会很满意这样做，每列要复制一行。仍然有重复的代码，但我认为它是可以管理的。