excel - 将行转置为列，但我只是从一组数据中选择需要转置的元素

Question

我试图通过将某些数据集从 sheet1 移动到 sheet2 来操作一组数据。我在 sheets2 上有一个由 16 个元素组成的标题，它们始终是相同的标题。
我收集数据并将它们写入 sheet1 。它们分为两列:
A 列: 由标题组成(水平，行 - 57 个元素)，
B 列: 包含这些 header 的值。
现在，我需要从 sheet2 中选择一个 header 并将其与 sheet1 中的 header 匹配，如果找到匹配项，则复制与该 header 相邻的值，在 sheet1 中，并将其粘贴到 sheet2 中的同一 header 下，在下一个可用行。
为了节省空间，我有 sheet1 和 sheet2 的 a partial screenshot 和我有一个适用于前 5 个元素的 VBA 代码，然后终止。我没有收到任何错误我只是没有将所有 16 个元素转移到 sheet2 。

Sub headerLookup()

Dim ShtONE As Worksheet
Dim ShtTWO As Worksheet
Dim shtONEHead As Range 
Dim shtTWOHead As Range
Dim headerONE As Range 
Dim headerTWO As Range

Set ShtONE = Sheets("Sheet1")
Set ShtTWO = Sheets("Sheet2")


Dim lr As Long
Dim lc As Long
Dim lRow As Long

'get all of the headers in the first sheet, in Column 1(Horizantal) to get 57 rows

lr = ShtONE.Cells(Rows.Count, 1).End(xlUp).Row

Set shtONEHead = ShtONE.Range("A1", ShtONE.Cells(lr, 1))

'get all of the headers in second sheet, 16 columns
lc = ShtTWO.Cells(1, Columns.Count).End(xlToLeft).Column

Set shtTWOHead = ShtTWO.Range("A1", ShtTWO.Cells(1, lc))

'loop through Rows and find matching values on Columns then copy the value of the adjacent  cell and paste it on sheet2
For Each headerTWO In shtTWOHead
    For Each headerONE In shtONEHead
   
        If headerTWO.Value = headerONE.Value Then
        
            headerONE.Offset(0, 1).Copy
            headerTWO.Offset(1, 0).PasteSpecial xlPasteAll
            Application.CutCopyMode = False
          GoTo Next_headerTWO
        End If

        Next headerONE
        
Next_headerTWO:
Next headerTWO

   
End Sub

Answer 1

好的，我认为这可以满足您的要求。如果我从头开始执行此操作，我会使用索引功能，但是使用您上面的代码，我已经对其进行了编辑以完成以下操作。几个更正:

你不是 追加 您的数据，这似乎是您通过“下一个可用行”所陈述的内容。这就是您可能需要 VBA 的原因。

您的循环有一个不寻常的导出。无需为这么小的数据集插入功能，但如果您这样做，请使用 exit for .

无论如何，您可以使用 this sample sheet 进行测试我做了。
它包括以下代码:

Sub headerLookup()
Const firstSheetName As String = "Sheet1"
Const secondSheetName As String = "Sheet2"


'Define the sheets
Dim ShtONE As Worksheet, ShtTWO As Worksheet
    Set ShtONE = ThisWorkbook.Sheets(firstSheetName)
    Set ShtTWO = ThisWorkbook.Sheets(secondSheetName)

'get all of the headers in the first sheet, in Column 1(Horizantal) to get 57 rows
    Dim lr As Long, shtONEHead As Range
    lr = ShtONE.Cells(Rows.Count, 1).End(xlUp).Row
    Set shtONEHead = ShtONE.Range("A1", ShtONE.Cells(lr, 1))


'get all of the headers in second sheet, 16 columns
Dim lc As Long, shtTWOHead As Range
    lc = ShtTWO.Cells(1, Columns.Count).End(xlToLeft).Column
    Set shtTWOHead = ShtTWO.Range("A1", ShtTWO.Cells(1, lc))
    
'You need to identify the column to enter data.
Dim theInputRow As Long
    theInputRow = ShtTWO.Cells(Rows.Count, 1).End(xlUp).Row


'Loop through rows and columns (there are better ways to do this but adopting your range for illustration)
Dim headerONE As Range, headerTWO As Range
    For Each headerTWO In shtTWOHead.Cells
        For Each headerONE In shtONEHead.Cells
            If headerTWO.Value = headerONE.Value Then
                headerTWO.Offset(theInputRow, 0).Value = headerONE.Offset(0, 1).Value
                
                'you don't realy need to worry about performance, but if you do use EXIT FOR
                'Exit For
    
            End If
    
        Next headerONE
    Next headerTWO

End Sub