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

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

工作表中的

我有：

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

工作表中的

我得到了：

  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

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

后续编辑：

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

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

<强> Sheet 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因为我们没有复制标题行）：< / p>

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")

我很满意这样做，每列需要复制一行。还有重复的代码，但在我看来它是可管理的。