如何將每行填充的列值提取到 Excel 中的另一張表

Question

我有一個包含數百列和行的 Excel 文件。 對於每一行，只有大約五六列是適用的，並且填充了一些值。 我想將每行填充的列（包括標題）復制到新工作表並刪除空的列，例如：

原單：

水果種類	綠色的	黃色	紅色的	棕色的
蘋果	有時		是的
梨				是的
香蕉		是的

所需表：

水果種類
蘋果	綠色的	紅色的
	有時	是的
梨	棕色的
	是的
香蕉	黃色
	是的

任何幫助將不勝感激。

Answer 1

這應該這樣做。 如果需要，您可以更改配置部分中的值以進行一些調整。

Sub organize()

Dim row_header As Integer, total_cols As Long, col_n As Long
Dim target_next_row As Long, target_next_col As Long
Dim row_n As Long, new_sheet As String, main As String
Dim counter As Long, db_col_start As Integer, last_row As Long

'CONFIG
'---------------------------
row_header = 1            'in what row is the header?
db_col_start = 1          'in what col number does the data start?
main = "Sheet1"           'sheet name with the data set
new_sheet = "New Sheet"   'name of the sheet to create
'---------------------------

target_next_row = 3

'create new sheet
Sheets.Add.Name = new_sheet

'tranfer "Type of Fruit" title to new sheet
Sheets(new_sheet).Cells(1, 1) = Sheets(main).Cells(row_header, db_col_start)
Sheets(new_sheet).Cells(1, 1).Font.Bold = True

'get the total number of columns & rows
total_cols = _
Sheets(main).Cells(row_header, Columns.count).End(xlToLeft).Column

last_row = _
Sheets(main).Cells(Rows.count, db_col_start).End(xlUp).Row

For counter = 1 To last_row - row_header
    Sheets(new_sheet).Cells(counter * 3, 1) = _
    Sheets(main).Cells(row_header + counter, db_col_start)
Next counter

For row_n = row_header + 1 To last_row
    target_next_col = 2
    For col_n = db_col_start + 1 To total_cols
    
        If IsEmpty(Sheets(main).Cells(row_n, col_n)) = False Then
            Sheets(new_sheet).Cells(target_next_row, target_next_col) = _
            Sheets(main).Cells(row_header, col_n)
            Sheets(new_sheet).Cells(target_next_row, target_next_col).Font.Bold = True
            Sheets(new_sheet).Cells(target_next_row + 1, target_next_col) = _
            Sheets(main).Cells(row_n, col_n)
            target_next_col = target_next_col + 1
        End If
    
    Next col_n
    target_next_row = target_next_row + 3
Next row_n
   
End Sub