Multi-row and multi-column excel spreadsheet into single column keeping column A as key

问题

Consider a table:

a       b        c       d
key1   value1   value2   value3
key2   value1a           value3a

i need to convert this into

Key1 Value1
Key1 Value2
Key1 Value3
Key2 Value1a
Key2 
key2 Value3a

this code, works in putting all the data into a single column, including spaces as required, but i need to keep the first column as a key and I'm new to VBA in excel.

  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

The tables are approximately 55 rows with 12 to 30 columns. I ideally also need to convert 20 or so sheets in the same way, so a programmatic way of doing this would be ideal, can SO help?

回答1:

Here is a basic example of how you could get something like that working. Hopefully this will be helpful as a concept and you can tweak to best suit what you're looking for:

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

来源：https://stackoverflow.com/questions/13567161/multi-row-and-multi-column-excel-spreadsheet-into-single-column-keeping-column-a

标签

excel

excel-vba

vba