如何創建一個新的選項卡，其中存在值的所有列及其相應的行名稱？

Question

我當前的表格由代表不同帳戶的不同類別和列的行組成。它看起來像下面

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

我想創建一個具有所有非零，且沒有遺漏值的新標籤，其對應的類別名稱，每個帳戶匹配如下

  account 1     account 2 ...   account n 
category 2  5  category 1  15  category 1  22 
     m  3  category 3  3  category 2  3 
         category 10  10  category m  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 

見參考圖像：

源工作表

目標表