excel - 如何使用 VBA/宏根据行内容将一些输入行转换为多个新行？

Question

我有一个 4 页的 Excel 表，它输入预算调整数据并重新格式化为两种不同的格式，以便输入不同的预算软件。
在工作表的第一页，即上传页面(提要数据)上，数据以预算调整行的形式给出。这些调整总是出现在偶数行中，因为对于每个调整了资金的账户，另一个账户都调整了资金。在每一行中，有许多描述调整的非唯一定性列，然后是记录调整的货币方面的 12 个月列。有些行只有 12 行中的一个月，可以单独放置。其他调整发生在几个月内，因此填充了几个月的列。
对于两个预算软件的输入，这些具有多个月份列的数据行需要扩展为多个新行，仅填充 12 列中的一个。为清楚起见，转换应如下所示:
输入:

输出:

对于某些行不需要转换的输入数据，有些行包含 2 个月的交易，有些最多可包含 12 行，您如何做到这一点？

Answer 1

Option Explicit

Sub Only_one_data_value_per_row()

    Dim myR As Range
    Dim rowCt As Integer
    Dim actRange As Range
    Dim dataCt As Integer
    Dim iCt As Integer
    Dim myCell As Range
    
    Set actRange = Range("A1").CurrentRegion
    
    For rowCt = actRange.Rows.Count To 2 Step -1
    
        With ActiveSheet.Rows(rowCt)
            dataCt = Application.WorksheetFunction.Count(.Range("E1:P1"))
            'Debug.Print .Range("E1:P1").Address, dataCt)
            
            For iCt = 1 To dataCt - 1
                Rows(rowCt + 1).EntireRow.Insert
                Rows(rowCt).Range("A1:D1").Copy Rows(rowCt + 1).Range("A1")
            Next iCt
            
            iCt = 0
            For Each myCell In Rows(rowCt).Range("E1:P1")
                'Debug.Print rowCt; ":"; (nonEmptyCell)
                If myCell.Value <> "" Then
                    Debug.Print myCell.Value
                    If Val(myCell.Value) = 0 Then
                        MsgBox "The value of the cell " & myCell.Address & _
                               " is 0! The cell will be deleted!"
                        myCell.Value = ""
                    Else
                        If iCt > 0 Then
                            myCell.Offset(iCt, 0).Value = myCell.Value
                            myCell.Value = ""
                        End If
                        iCt = iCt + 1
                    End If
                End If
            Next myCell
        End With
    Next rowCt
End Sub

输入:

输出: