如何创建一个新选项卡，其中包含存在值的所有列及其对应的行名称？

Question

我当前的表包含代表不同帐户的不同类别和列的行。它看起来像以下

srv

我想创建一个新标签，其中包含所有非零和非缺失值，其对应的类别名称与每个帐户匹配，如下所示

              account 1, account 2, ..., account n
category 1                   15             22
         2       5                           3
         3       0            3
         ...
         m       3           10             15

我需要在每个类别/帐户集之间留出1列空格。如果重要的话，我将如何在Excel 2010或2013中执行此操作？

Answer 1

这应该适合你：

Sub Demo()
    Dim lastRow As Long, lastColumn As Long, i As Long
    Dim srcWB As Workbook
    Dim srcWS As Worksheet, destWS As Worksheet
    Dim srcRng As Range, rng As Range

    Set srcWB = ThisWorkbook
    Set srcWS = srcWB.Sheets("Sheet1")    '->enter sheet name with data
    Set destWS = srcWB.Sheets("Sheet2")    '->enter sheet name for result

    lastRow = Cells(Rows.Count, "A").End(xlUp).Row    '->gives last row with data
    lastColumn = Cells(1, Columns.Count).End(xlToLeft).Column    '->gives last column with data

    With srcWS
        For i = 2 To lastColumn    '->loop through all columns
            Set srcRng = .Range(.Cells(2, i), .Cells(lastRow, i))
            Set rng = Union(.Cells(1, 1), .Cells(1, i))    '->this line is for header
            For Each cel In srcRng
                If Not IsEmpty(cel) And cel.Value > 0 Then    '->check condition for blanks and 0's
                    Set rng = Union(rng, Union(.Cells(cel.Row, 1), cel))
                End If
            Next cel
            rng.Copy Destination:=destWS.Cells(1, ((i - 1) * 2 - 1))    '->paste range to destination sheet
            Set rng = Nothing    '->set rng to nothing
        Next i
    End With
End Sub

见图片参考：

来源表

目标表