0

別のアプリケーションにインポートするために、Excel から CSV としてエクスポートする必要があるかなり大きなデータセットがあります。重複した列見出しを持つことはできませんが、現時点では重複する例が多数あります。これらの見出しとそれぞれのデータを 1 つの列に統合し、重複を削除する必要があります。

私はこのようなデータを取ろうとしています:

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 ずつ増やす必要があります。

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 に答える