如何在公共列標題存在時合併來自多行的數據？

Question

我有一個相當大的數據集，需要從Excel導出爲另一個應用程序的CSV文件。它不能有重複的列標題，但是目前有很多這種情況發生。我需要將這些標題及其各自的數據合併爲單列並刪除重複項。

我試圖把數據是這樣的：

MAKE | MAKE | MAKE | MODEL | MODEL | TRIM | 
------------------------------------------- 
FORD |  |  |  |  |  | 
-------------------------------------------  
    | FIAT |  |  |  |  | 
------------------------------------------- 
    |  | MINI |  |  |  | 
------------------------------------------- 
    |  |  | PILOT |  |  | 
------------------------------------------- 
    |  |  |  | SC400 |  | 
------------------------------------------- 
    |  |  |  |  | EX | 
------------------------------------------- 

，並把它變成這樣：

MAKE | MODEL | TRIM | 
--------------------- 
FORD |  |  | 
---------------------  
FIAT |  |  | 
--------------------- 
MINI |  |  | 
--------------------- 
    | PILOT |  | 
--------------------- 
    | SC400 |  | 
--------------------- 
    |  | EX | 
--------------------- 

預先感謝在完成這個任何幫助。

Answer 1

您需要在較小的位分離開的問題：

1. 閱讀獨特的遊戲，和他們（保存在一個字典對象作爲其值，你可能想堅持他們將被保存在列in）

2. 您遍歷每個獲取值並讀取列標題的單元格。

3. 你把它寫在價值上當前你迭代通過列一個新的工作表，但對於列位置您查找當前列標題在字典裏並獲取其位置。

編輯：代碼測試和調試。效果很好。

注意：此方法假定每行每個重複列只有1個值。 如果您有多個值爲1的重複列，那麼程序將始終保存最後一個值（因爲它將覆蓋以前的值）。如果你想要一個處理每列多個值的方法，那麼你需要爲新表格中的每一列保留一個行號，並在每次在該列中寫入數據時將其增加1。

Sub WriteValues() 

    'Aassuming your column titles are in row 1 
    Dim mainSheet As Worksheet 
    Set mainSheet = ActiveSheet 

    Dim maxCols As Integer 
    Dim maxRows As Double 
    maxRows = 0 
    maxCols = Cells(1, Columns.Count).End(xlToLeft).Column 

    Dim colPositions As Dictionary 
    Set colPositions = New Dictionary 

    'Iterate throgh row 1 to get all uniue values 
    Dim iCol As Integer 
    For iCol = 1 To maxCols 
     On Error Resume Next 
      colPositions.Add Cells(1, iCol).Value, colPositions.Count + 1 
     On Error GoTo 0 
     'Also record maxRows 
     If Cells(rows.Count, iCol).rows.End(xlUp).row > maxRows Then 
      maxRows = Cells(rows.Count, iCol).rows.End(xlUp).row 
     End If 
    Next i 

    Dim newSheet As Worksheet 
    Set newSheet = Sheets.Add 

    Dim col As Integer 
    Dim row As Double 


    'Write column titles in new sheet 
    Dim v As Variant 
    iCol = 1 
    For Each v In colPositions 
     Cells(1, iCol).Value = v 
     iCol = iCol + 1 
    Next v 

    'Main data iterator 
      For row = 2 To maxRows 
     For col = 1 To maxCols 

     Dim cellValue As String 
     Dim valueColumn As String 

     With mainSheet 
      cellValue = .Cells(row, col).Value 
      valueColumn = .Cells(1, col).Value 
     End With 
     If cellValue <> "" Then 
      newSheet.Cells(row, colPositions(valueColumn)).Value = cellValue 
     End If 
     Next col 
    Next row 
End Sub