将不一致的数据集从列转置为行 csv 或 excel

Question

您好，我有一个包含大约 380k 行和树列的 csv 文件。 A 列 - 我有钥匙，它对每个装饰版本都重复，每个装饰版本每次都以“品牌”一词开头 B 列 - 规范 C 列 - 修剪 ID，每个修剪版本的编号相同

我的问题是我的数据范围不一致，一些修剪版本有多达 55 行数据，而其他只有 5-6 行

(A)KEY                              (B)VALUE            (C)TRIM ID
======                              ========            ==========
1. Brand                            Mitsubishi          20001
2. Model                            ASX                 20001
3. Trim                             ASX (facelift 2012) 20001
4. Engine                           1.8 DI-D (114 Hp)   20001
5. Doors                            5                   20001
6. Power                            114 hp              20001
7. Maximum speed                    189 km/h            20001
8. From 0 to 100 km/h               10.2 sec            20001
9. Fuel tank volume                 63 l                20001
10. Year into production            2012                20001
11. Seats                           5                   20001                       
1. Brand                            BMW                 20015
2. Model                            M4                  20015
3. Trim                             M4 (F83)            20015
4. Engine                           3.0 (431 Hp) DCT    20015
5. Power                            431 hp              20015
1. Brand                            AUDI                25003
2. Model                            A4                  25003
3. Trim                             1.9TDI AVANT SLINE  25003
4. Power                            131 hp              25003

我想将数据转置为 ONE ROW PER TRIM VERSION 并匹配数据。例如，每次找到品牌时，都会从数据开始新行，其余数据与列名品牌、型号...座位等相匹配。

像这样：

Brand   Model   Generation  Engine  Doors   Power   Maximum speed   Seats   Length
=====   =====    =========   =====  =====   =====   =============   =====   ======
AUDI    A4      2.0T SLINE  2.0T    5       210     220             4         4520
BMW     M3                  330                     280             4
HONDA   CIVIC               1.6i    4       160                     4

我试图用函数解决这个问题，但我认为我需要 vba 脚本，但我并不擅长。请帮帮我。

Answer 1

好吧，我做到了（以及您提供的数据样本）

Sub createDataTable()
    Dim r
    Dim c
    Dim i
    Dim rng As Range
    Dim newSht As Worksheet
    Dim dataSht As Worksheet
    Dim j 'the counter for the rows of the table
    Dim colName As Range
    Dim theAddress

    Set dataSht = Sheets("Data")
    dataSht.Activate
    r = Range("A1").End(xlDown).Row 'take the last row of the data
    c = Range("A1").End(xlToRight).Column 'Take the last columns of the data
    Set rng = Range(Cells(2, 1), Cells(r, 1)) 'Store the column 1=A of the data

    Sheets.Add After:=Sheets(Sheets.Count) 'Add a new sheet
    Set newSht = ActiveSheet 'Store the new sheet int the var
    newSht.Name = myTime 'Rename the new sheet with the function
    j = 1

    dataSht.Activate
    rng.Copy
    Range("H1").PasteSpecial xlPasteAll
    Application.CutCopyMode = False

    ActiveSheet.Range("$H:$H").RemoveDuplicates Columns:=1, Header:=xlNo

    Range("H1", Selection.End(xlDown)).Copy
    newSht.Activate
    Range("A1").PasteSpecial Paste:=xlPasteAll, Transpose:=True
    Rows("1:1").Font.Bold = True

    dataSht.Activate 'Go to the new sheet (just in case)
    Range("H1", Selection.End(xlDown)).ClearContents

    For Each i In rng 'Here comes the magic
        If i.Value = "Brand" Then 'If is a Brand set a new row
            j = j + 1
        End If
        newSht.Activate 'Lets go to the new sheet
        With newSht.Range("A1:BZ1") 'With the headers...
            Set colName = .Find(i.Value, LookIn:=xlValues) '...Find the header of the column in that range
            If Not colName Is Nothing Then 'If colName has something then
                theAddress = colName.Address 'Put the address of the address just for reference
                Do 'and inner loop
                    Range(Cells(j, colName.Column), Cells(j, colName.Column)).Value = i.Offset(0, 1).Value
                    'put the value of the field inside the cell below the right header in the right row
                    'col header = colName.column
                    'right row = j
                    'Set colName = .FindNext(colName) 'this is not necesary, because the header are unique
                Loop While Not colName Is Nothing And colName.Address <> theAddress
            End If
        End With
        dataSht.Activate
    Next i
End Sub

编辑#1

此代码创建标题

Sub createDataTable()
    Dim r
    Dim c
    Dim i
    Dim rng As Range
    Dim newSht As Worksheet
    Dim dataSht As Worksheet
    Dim j 'the counter for the rows of the table
    Dim colName As Range
    Dim theAddress

    Set dataSht = Sheets("Data")
    dataSht.Activate
    'to create headers
    Rows("1:1").Insert Shift:=xlDown
    Range("A1").FormulaR1C1 = "Key"
    Range("B1").FormulaR1C1 = "Value"
    Range("C1").FormulaR1C1 = "Trim"
    Rows("1:1").Font.Bold = True

    r = Range("A1").End(xlDown).Row 'take the last row of the data
    c = Range("A1").End(xlToRight).Column 'Take the last columns of the data
    Set rng = Range(Cells(2, 1), Cells(r, 1)) 'Store the column 1=A of the data

    Sheets.Add After:=Sheets(Sheets.Count) 'Add a new sheet
    Set newSht = ActiveSheet 'Store the new sheet int the var
    newSht.Name = myTime 'Rename the new sheet with the function
    j = 1

    dataSht.Activate
    rng.Copy
    Range("H1").PasteSpecial xlPasteAll
    Application.CutCopyMode = False

    ActiveSheet.Range("$H:$H").RemoveDuplicates Columns:=1, Header:=xlNo

    Range("H1", Selection.End(xlDown)).Copy
    newSht.Activate
    Range("A1").PasteSpecial Paste:=xlPasteAll, Transpose:=True
    Rows("1:1").Font.Bold = True

    dataSht.Activate 'Go to the new sheet (just in case)
    Range("H1", Selection.End(xlDown)).ClearContents

    For Each i In rng 'Here comes the magic
        If i.Value = "Brand" Then 'If is a Brand set a new row
            j = j + 1
        End If
        newSht.Activate 'Lets go to the new sheet
        With newSht.Range("A1:BZ1") 'With the headers...
            Set colName = .Find(i.Value, LookIn:=xlValues) '...Find the header of the column in that range
            If Not colName Is Nothing Then 'If colName has something then
                theAddress = colName.Address 'Put the address of the address just for reference
                Do 'and inner loop
                    Range(Cells(j, colName.Column), Cells(j, colName.Column)).Value = i.Offset(0, 1).Value
                    'put the value of the field inside the cell below the right header in the right row
                    'col header = colName.column
                    'right row = j
                    'Set colName = .FindNext(colName) 'this is not necesary, because the header are unique
                Loop While Not colName Is Nothing And colName.Address <> theAddress
            End If
        End With
        dataSht.Activate
    Next i
End Sub

正如我在屏幕截图中看到的，您将代码放在工作表中，这将返回错误 1004

因为您无法从工作表中“操作”另一个工作表。如果您需要/想要这样做，则需要在模块内进行，然后从该模块调用过程。

在这种情况下，您需要添加一个新模块 在 VBA 中选择工作簿

Insert >>> Module

您的项目中会出现一个新模块，然后将 Edit #2 中的过程添加到该模块中，然后使用F5 运行它。

如果您需要改进，请告诉我。

编辑#2

很高兴为您提供帮助...您遇到的错误是因为我确实向您发送了自定义函数...抱歉...来了！

Function myTime() As String
    Dim HH
    Dim MM
    Dim SS
    Dim TT
    HH = Hour(Now)
    MM = Minute(Now)
    SS = Second(Now)
    myTime = Format(HH, "00") & Format(MM, "00") & Format(SS, "00")
End Function

将此函数放在您放置所有代码的同一模块中。

Answer 2

我认为这可以通过数据透视表轻松完成。只需将您的 csv 数据导入 excel 并将其转换为数据透视表即可。

Answer 3

我会回答我的问题，因为我为这个问题找到了一个完美而强大的解决方案，称为 OpenRefine，它是一个前谷歌项目 (Google Refine)。

由于我的数据集现在超过一百万行，这是最快和最好的解决方案（比 excel 好得多）。

http://openrefine.org/