Question

考虑一个表：

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张左右的纸张，所以这样做的程序化方法是理想的，可以帮助吗？

Answer 1

这是一个基本的例子，说明如何使这样的工作得以实现。希望这将有助于作为一个概念，你可以调整到最适合你想要的东西：

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

多行和多列excel电子表格成单列，保持列A为关键

1 个答案: