将水平数据插入垂直格式

Question

我有一个数据表，这样信息的特定列需要从水平布局转换并垂直插入到初始行的下方。为了使事情变得更复杂，需要忽略任何值为零的列，并且每行可能有一个不同的列为零。

到目前为止，我已经从stackoverflow的“DisplayName”的帮助下得到了，但线程变得沉默。我很确定我有太多的跟进。完全是我的错，因为我试图简化问题，这让我的答案变得更加困难。

此查询非常接近，但出于某种原因，在此数据集上运行时，它不会获取所有水平数据。由于某种原因，它停在列“S”而不是列“CZ”列。同样在“B”列中有零的行中，它不会获取帐号，只是将收入代码和费用添加到其上方的名称（请参阅跳过帐户123123141的位置，但对象编号已添加到123123140） 。

如果可能（我无法弄清楚），我可以附加实际的.xlsm文件。

Sub H2V()
' Vertically integrate horizontal revenue code data
' Keyboard Shortcut: Ctrl+Shift+Q
Dim headers As Variant, names As Variant, data As Variant
Dim iRow As Long

With Worksheets("Template")
    With Intersect(.UsedRange, .Range("A:CZ"))
        headers = Application.Transpose(Application.Transpose(.Offset(, 1).Resize(1, .Columns.Count - 1).Value))
        names = Application.Transpose(.Offset(1).Resize(.Rows.Count - 1, 1).Value)
        data = .Offset(1, 1).Resize(.Rows.Count - 1, .Columns.Count - 1).Value
        .ClearContents
        .Resize(1, 3).Value = Array("Patient Number", "Rev Code", "Charges")
    End With

    For iRow = 1 To UBound (data)
        With .Cells(.Rows.Count, "B").End(xlUp)
            .Offset(1, -1).Value = names(iRow)
            .Offset(1, 0).Resize(UBound(headers)).Value = Application.Transpose(headers)
            .Offset(1, 1).Resize(UBound(data)).Value = Application.Transpose(Application.Index(data, iRow, 0))
        End With
    Next

    With .Range("B3", Cells(.Rows.Count, "B").End(xlUp)).SpecialCells(xlCellTypeConstants)
        .Offset(, 1).Replace What:="0", Replacement:="", LookAt:=xlWhole
        .Offset(, 1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    End With
End With
End Sub

Answer 1

这会将丢失的数据水平修复..但它仍在跳过帐户123123141，我不知道为什么..

For iRow = 1 To UBound(data, 1)
        With .Cells(.Rows.Count, "B").End(xlUp)
            .Offset(1, -1).Value = names(iRow)
            .Offset(1, 0).Resize(UBound(headers)).Value = Application.Transpose(headers)
            .Offset(1, 1).Resize(UBound(data, 2)).Value = Application.Transpose(Application.Index(data, iRow, 0))
        End With
    Next