excel - 基于列标题传输值的代码

Question

我们有一个 Excel 表，其中包含列标题 MIC 和版本。表 1：

SCRNHYF1 SCRNRBF1 SCRNEBF1            
MIC版本下限上限MIC版本下限上限MIC版本下限上限
50015357 1 95 100 50015357 1 95 100 50015359 1 90 100
50015358 1 0 100 50015358 1 0 100 50015360 1 0 100
50014016 3 95 100 50014016 3 95 100 50014016 1 90 100
50010606 2 0 100 50010606 2 0 100 50010606 15 0 100
50000779 3 95 100 50000779 3 95 100 50000779 16 90 100
50010608 2 0 100 50010608 2 0 100 50010608 15 0 100
50150795 1 95 100 50150795 1 95 100 50150795 2 90 100
50150796 1 0 100 50150796 1 0 100 50150796 2 0 100

我希望 VBA 代码将 sheet1 中的数据重新排列到 sheet2 中，如下所示。请注意：我们在 sheet1 中多次重复这些 MIC 和版本标题。表2：

RoS MIC 版本
SCRNHYF1 50015357 1
SCRNHYF1 50015358 1
SCRNHYF1 50014016 3
SCRNHYF1 50010606 2
SCRNHYF1 50000779 3
SCRNHYF1 50010608 2
SCRNHYF1 50150795 1
SCRNHYF1 50150796 1
SCRNRBF1 50015357 1
SCRNRBF1 50015358 1
SCRNRBF1 50014016 3
SCRNRBF1 50010606 2
SCRNRBF1 50000779 3
SCRNRBF1 50010608 2
SCRNRBF1 50150795 1
SCRNRBF1 50150796 1
SCRNEBF1 50015359 1
SCRNEBF1 50015360 1
SCRNEBF1 50014016 1
SCRNEBF1 50010606 15
SCRNEBF1 50000779 16
SCRNEBF1 50010608 15
SCRNEBF1 50150795 2
SCRNEBF1 50150796 2

到目前为止我的代码......这是行不通的......

Sub CopyRng()

Dim WS1 As Worksheet
Dim WS2 As Worksheet
Dim Rng As Range
Dim Col As Long

On Error Resume Next    

Set WS1 = Sheets("Sheet1")
Set WS2 = Sheets("Sheet2")

Set Rng = WS1.Range("E1:E25")    

With WS2

    Col = Application.WorksheetFunction.Match(WS1.Range("E1").Value, .Rows("1:1"), False)
'Writes the values to the last empty cell from the bottom of the column:
    .Cells(.Rows.count, Col).End(xlUp).Offset(1, 0).Resize(Rng.Rows.count).Value = Rng.Value


End With

End Sub

Answer 1

您需要处理Match()失败的情况：我更喜欢删除.Worksheetfunction并测试返回值以查看它是否是错误。

Sub CopyRng()

Dim WS1 As Worksheet
Dim WS2 As Worksheet
Dim Rng As Range
Dim Col 

Set WS1 = Sheets("Sheet1")
Set WS2 = Sheets("Sheet2")

Set Rng = WS1.Range("E1:E25")    

With WS2

    Col = Application.Match(WS1.Range("E1").Value, .Rows("1:1"), False)
    If Not IsError(Col) Then
         'Writes the values to the last empty cell from the bottom of the column:
         .Cells(.Rows.count, Col).End(xlUp).Offset(1, 0). _
                       Resize(Rng.Rows.count).Value = Rng.Value

    Else
         msgbox "Not found!"
    End If

End With

End Sub