常见列标题存在时如何组合来自多行的数据？

我有一个相当大的数据集，需要从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. 阅读独特的标题，并将其保存在一个Dictionary对象中（作为一个值，你可能想要保存在他们将被保存的列）

2. 您遍历每个单元格获取值和读取列标题。

3. 您将该值写入当前正在迭代的列中的新工作表中，但是对于列位置，您可以查找字典中的当前列标题并获取其位置。

编辑：代码testing和debugging。 效果很好。

注意：此方法假定每行每个重复列只有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