【问题标题】:Multi-row and multi-column excel spreadsheet into single column keeping column A as key多行多列的 Excel 电子表格转换为单列,将 A 列作为键
【发布时间】:2012-11-26 23:24:16
【问题描述】:

考虑一个表格:

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 张左右的工作表,因此以编程方式执行此操作将是理想的,有帮助吗?

【问题讨论】:

    标签: excel vba


    【解决方案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
    

    【讨论】:

    • 我只是在输入这个。内部循环和索引器来跟踪新工作表上的行。 +1!
    • @KutF 没问题,希望对你有帮助。
    猜你喜欢
    • 1970-01-01
    • 2022-07-24
    • 1970-01-01
    • 2020-11-06
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    相关资源
    最近更新 更多