0

我有一个相当大的数据集，需要从 Excel 导出为 CSV 以导入另一个应用程序。它不能有重复的列标题，但此时发生这种情况的实例很多。我需要将这些标题及其各自的数据合并到单个列中并删除重复项。

我正在尝试获取这样的数据：

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

并将其变成这样：

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

在此先感谢您提供的任何帮助。

4

1 回答 1

2

您需要将问题分成更小的部分：

  1. 读取唯一标题并将它们保存在 Dictionary 对象中（作为您可能希望保存在它们将被保存的列上的值）

  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
于 2013-03-28T15:48:12.823 回答