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

您需要将问题分成较小的位：

读取唯一标题并将其保存在Dictionary对象中（作为您希望保存在要保存的列中的值）
您遍历每个单元格获取值并读取列标题。
您可以在当前正在迭代的列的新工作表中写入该值，但是对于列位置，您可以在字典中查找当前列标题并获取其位置。

编辑：代码测试和调试。效果很好。

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

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

1 个答案: