将多行和多列的excel电子表格保存到单列中，并保持列A为键 [英] Multi-row and multi-column excel spreadsheet into single column keeping column A as key

问题描述

考虑表格:

a       b        c       d
key1   value1   value2   value3
key2   value1a           value3a

我需要将其转换为

Key1 Value1
Key1 Value2
Key1 Value3
Key2 Value1a
Key2 
key2 Value3a

此代码可将所有数据放入一个单独的列中，包括所需的空格，但是我需要保留第一列作为键，并且我是excel中VBA的新手.

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 

这些表大约有55行，共有12到30列.理想情况下，我还需要以相同的方式转换20张左右的工作表，因此以编程方式进行此操作比较理想，可以帮忙吗?

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?

推荐答案

这里是一个基本示例，说明如何获得这种效果.希望这将从概念上有所帮助，并且您可以进行调整以最适合您要寻找的内容:

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

这篇关于将多行和多列的excel电子表格保存到单列中，并保持列A为键的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！