0

考虑一个表：

a       b        c       d
key1   value1   value2   value3
key2   value1a           value3a

我需要把它转换成

Key1 Value1
Key1 Value2
Key1 Value3
Key2 Value1a
Key2 
key2 Value3a

此代码用于将所有数据放入单个列中，包括所需的空格，但我需要将第一列保留为键，而且我是 Excel 中的 VBA 新手。

  Sub MultiColsToA() 
Dim rCell As Range 
Dim lRows As Long 
Dim lCols As Long 
Dim lCol As Long 
Dim ws As Worksheet 
Dim wsNew As Worksheet 

lCols = Columns.Count 
lRows = Rows.Count 
Set wsNew = Sheets.Add() 

For Each ws In Worksheets 
    With ws 
        For Each rCell In .Range("B1", .Cells(1, lCols).End(xlToLeft)) 
            .Range(rCell, .Cells(lRows, rCell.Column).End(xlUp)).Copy _ 
            wsNew.Cells(lRows, 1).End(xlUp)(2, 1) 
        Next rCell 
    End With 
Next ws 

End Sub

这些表大约有 55 行，12 到 30 列。理想情况下，我还需要以相同的方式转换 20 张左右的表格，因此以编程方式执行此操作将是理想的，可以帮忙吗？

4

1 回答 1

3

这是一个基本示例，说明如何使类似的东西正常工作。希望这作为一个概念会有所帮助，您可以进行调整以最适合您的需求：

Sub MultiColsToA()

    Dim rCell As Range
    Dim cCell As Range
    Dim iCounter As Integer
    Dim iInner As Integer
    Dim ws As Worksheet
    Dim wsNew As Worksheet

    ' Find the full range of the original sheet (assumes each row
    ' in column A will have a value)
    Set rCell = Range("A1:A" & Range("A1").End(xlDown).Row)
    Set wsNew = Sheets.Add()

    For Each ws In Worksheets
        ' Set our sentinel counter to track the row
        iCounter = 1

        ' Iterate through each cell in the original sheet
        For Each cCell In rCell

          ' This will likely need to be adjusted for you, but
          ' here we set a counter = 1 to the number of columns
          ' the original sheet contains (here 3, but can be changed)
          For iInner = 1 To 3
              With wsNew
                  ' Set the first column = the key and the second the
                  ' proper value from the first sheet
                  .Cells(iCounter, 1).Value = cCell.Value
                  .Cells(iCounter, 2).Value = cCell.Offset(0, iInner).Value
              End With

              ' Increment the sentinel counter
              iCounter = iCounter + 1
          Next iInner
        Next cCell
    Next ws

End Sub
于 2012-11-26T15:24:16.823 回答