如何使用VBA在Excel中展平表格,其中数据在行之间分割?

Posted

tags:

篇首语:本文由小常识网(cha138.com)小编为大家整理,主要介绍了如何使用VBA在Excel中展平表格,其中数据在行之间分割?相关的知识,希望对你有一定的参考价值。

我目前在Excel中有一个原始数据表,它总结了给定订婚的阶段A,B和C的状态。有些参与可能没有所有3个阶段的数据。

Row| EngagementID | A_date | A_status | B_date | B_status | C_date | C_status
1  |      201     |   2/2  | Approved |        |          |        |          
2  |      201     |        |          |  3/5   | Approved |        |          
3  |      201     |        |          |        |          |  4/1   |  Pending  
4  |      203     |   2/12 | Submitted|        |          |        |          
5  |      203     |        |          |  2/20  | Approved |        |          
6  |      207     |   2/5  | Approved |        |          |        |          

我试图把桌子弄平,看起来像这样:

Row| EngagementID | A_date | A_status | B_date | B_status | C_date | C_status
1  |      201     |   2/2  | Approved |  3/5   | Approved |  4/1   |  Pending 
2  |      203     |   2/12 | Submitted|  2/20  | Approved |        |         
3  |      207     |   2/5  | Approved |        |          |        |          

问题:多个实例

但是,在相同的EngagementID具有多个实例的情况下。例如,它可能具有以下内容:

    Row| EngagementID | A_date | A_status | B_date | B_status | C_date | C_status
    1  |      201     |   2/2  | Approved |        |          |        |          
    2  |      201     |        |          |  3/5   | Approved |        |          
    3  |      201     |        |          |  3/18  | Pending  |        |           
    4  |      201     |        |          |        |          |  5/20  |  Pending  
    5  |      201     |        |          |        |          |  5/15  |  Submitted

我试图使VBA足够灵活,以便在这些情况下,表将被转换为

Row| EngagementID | A_date | A_status | B_date | B_status | C_date | C_status
1  |      201     |   2/2  | Approved |  3/5   | Approved |  5/20  |  Pending 
2  |      201     |   2/2  | Approved |  3/18  | Pending  |  5/15  |  Submitted

我能够使用以下VBA代码解决单实例方面:

Private Sub test()
Dim R As Long
Dim i As Integer
i = 1
R = 2
Count = 0
Do While Not IsEmpty(Range("A" & R))
    If Cells(R, 1).Value = Cells(R + 1, 1).Value Then
        Count = Count + 1
    Else
        i = 1
        Do While i <= Count
            Cells(R - Count, 2 + (2 * i)).Value = Cells(R - Count + i, 2 + (2 * i))
            Cells(R - Count, 3 + (2 * i)).Value = Cells(R - Count + i, 3 + (2 * i))
            i = i + 1
        Loop
            i = 1
            Do While i <= Count
                Rows(R - Count + i).Delete
                i = i + 1
                R = R - 1
            Loop
        Count = 0
    End If
R = R + 1
Loop

End Sub

但是,这并不考虑多个实例。关于我可以调整VBA以适应这种“多实例”场景的任何想法都将非常感激。谢谢!

答案

您可以使用Power Query轻松处理此问题。这是一个可以免费获得并在Excel 2010+中激活的附加工具(默认情况下在Excel 2016中称为Get&Transform)。在那里,您可以直接连接源并根据需要编辑数据。对于您的特定情况,请按照以下步骤

另一答案

EDITED

Option Explicit

Sub test()

Dim i As Long               ' loop
Dim iRow As Long            ' actual row to process
Dim i1stEmpy As Long        ' 1st empty cell
Dim iBlkStart As Long       ' this block starts here

Const colEngID = 2
Const colAdate = colEngID + 1
Const colAstat = colAdate + 1
Const colBdate = colAstat + 1
Const colBstat = colBdate + 1
Const colCdate = colBstat + 1
Const colCstat = colCdate + 1

iRow = 2        ' skip header row
Do While Trim$(Cells(iRow, 1)) <> vbNullString
    iBlkStart = iRow        ' 1st row of block of the same engagement
    For i = 0 To 2
        iRow = iBlkStart
        i1stEmpy = 0           ' next data comes here
        Do While Cells(iRow, colEngID) = Cells(iBlkStart, colEngID)
            If Trim$(Cells(iRow, colAdate + 2 * i)) = vbNullString Then
               If i1stEmpy = 0 Then i1stEmpy = iRow        ' set 1st empty cell
            Else
                If iRow <> iBlkStart And iRow <> i1stEmpy And i1stEmpy > 0 Then ' some data found
                    Cells(i1stEmpy, colAdate + 2 * i) = Cells(iRow, colAdate + 2 * i)  ' copy cell from below
                    Cells(i1stEmpy, colAstat + 2 * i) = Cells(iRow, colAstat + 2 * i)  ' copy cell from below
                    Cells(iRow, colAdate + 2 * i).Clear  ' clear cell
                    Cells(iRow, colAstat + 2 * i).Clear  ' clear cell
                    i1stEmpy = i1stEmpy + 1         ' set to next empty
                End If
            End If
            iRow = iRow + 1
        Loop
    Next i
    ' delete empty rows
    iRow = iBlkStart
    Do While Cells(iRow, colEngID) = Cells(iBlkStart, colEngID)
        If Trim$(Cells(iRow, colAdate)) = vbNullString And Trim$(Cells(iRow, colBdate)) = vbNullString And Trim$(Cells(iRow, colCdate)) = vbNullString Then    ' all cells are empty
            Cells(iRow, 1).EntireRow.Delete
        Else
            iRow = iRow + 1
        End If
    Loop
Loop ' irow

End Sub

以上是关于如何使用VBA在Excel中展平表格,其中数据在行之间分割?的主要内容,如果未能解决你的问题,请参考以下文章

如何使用 VBA 在 Excel 中添加连接(到外部数据源)并将其保存到该 Excel 电子表格的连接列表

如何使用 VBA 在 Excel 中正确添加表格列?

VBA实现将EXCEL数据导入WORD表格

Excel VBA 比较两个表格的不同?

在 Excel 中使用 VBA,如何在 Outlook 中粘贴表格然后将表格转换为文本?

在EXCEL中用VBA怎样操作WORD文档中嵌入的EXCEL表格?