重新整理表格/ CSV文件中的数据-Excel

时间：2018-09-06 14:58:21

标签： excel vba excel-vba csv

我有一个.csv文件（还有很多类似的文件），它们组织得不好。这是一个示例文件

Number,A1Name,A1DoVote,A1Vote,A2Name,A2DoVote,A2Vote,A3Name,A3DoVote,A3Vote,Solution
1,One,true,0,Two,false,50,Three,true,100,50.0
2,One,true,0,Two,false,50,Three,true,100,50.0
3,Two,true,100,One,true,0,Three,false,100,50.0
4,Two,true,100,One,true,0,Three,false,100,50.0
5,Three,true,100,One,true,0,Two,false,50,50.0
6,Three,false,100,One,true,0,Two,true,100,50.0
7,Three,true,100,One,true,0,Two,false,50,50.0
8,Three,false,100,One,true,0,Two,true,100,50.0
9,Two,false,50,Three,true,100,One,true,0,50.0
10,Two,true,100,Three,false,100,One,true,0,50.0
11,Three,true,100,Two,false,50,One,true,0,50.0
12,Three,false,100,Two,true,100,One,true,0,50.0

我在Excel中导入了它，但问题是我需要按名称来组织数据，因此“一个”，“两个”，“三个”而不是行数。是否有一种很好的方法来使数据始终始终显示“一个”，并在右侧显示与之相邻的两列，然后再显示“两个”，然后再显示“三”（再次与相邻的两个列一起显示？ 这些行是数据集，因此它们需要保持这种状态，我只想在列之间进行切换。

如果不清楚，请评论，我会尽快修复。

这是上面.csv代码在Excel中的样子

Original

这就是我想要的：

Modified

如您所见，“一”，“二”和“三”都在同一列中，并且两个右手边的值仍与它们相邻。 （Wahr是正确的，而falsch是错误的）

3 个答案:

答案 0 :(得分：0)

您应该发现这可行。所有范围等都是动态确定的，因此这将适用于长数据文件或短数据文件。数据被临时复制到数据范围的右侧（M至U列），然后剪切并复制回去。 

Sub VoteSortbyRow()

Dim lRow As Long, lCol As Long
Dim LR As Long, a1data As Long, a2data As Long, a3data As Long
Dim a1name As Long, a2name As Long, a3name As Long
Dim namecount As Long


    ' assign a value for the number of voyter name columns
    namecount = 3

    ' assign column number for left hand column of the three name ranges
    a1name = 2
    a2name = 5
    a3name = 8

    ' assign column number for left hand column of the three temporary data ranges (out to the right of the data)
    a1data = 13
    a2data = 16
    a3data = 19

    ' get the active sheet name
    MySheet = ActiveSheet.Name

    'Find the last non-blank cell in column B
    LR = Cells(Rows.Count, 2).End(xlUp).Row

    ' Select cell B2
    Cells(2, 2).Select



    For a1loop_ctr = 2 To LR
        'Statements to be executed inside the loop
        ' evaluate column B for value = One, Two or Three; copy data across to respective data ramge on the same row.
        If Cells(a1loop_ctr, a1name) Like "One" Then
            ActiveSheet.Range(Cells(a1loop_ctr, a1name), Cells(a1loop_ctr, (a1name + 2))).Copy Destination:=Cells(a1loop_ctr, a1data)
        ElseIf Cells(a1loop_ctr, a1name) Like "Two" Then
            ActiveSheet.Range(Cells(a1loop_ctr, a1name), Cells(a1loop_ctr, (a1name + 2))).Copy Destination:=Cells(a1loop_ctr, a2data)
        ElseIf Cells(a1loop_ctr, a1name) Like "Three" Then
            ActiveSheet.Range(Cells(a1loop_ctr, a1name), Cells(a1loop_ctr, (a1name + 2))).Copy Destination:=Cells(a1loop_ctr, a3data)
        Else
            'Error message and exist in case the cell is invalid
            MsgBox "VALIDATION ERROR: Cell " & Replace(Replace(Cells(1, a1name).Address, "1", ""), "$", "") & a1loop_ctr & " does not contain a valid voter Name"
            Exit Sub
        End If


    Next a1loop_ctr
    For a2loop_ctr = 2 To LR
        'Statements to be executed inside the loop
        ' evaluate column E for value = One, Two or Three; copy data across to respective data ramge on the same row.
        If Cells(a2loop_ctr, a2name) Like "One" Then
            ActiveSheet.Range(Cells(a2loop_ctr, a2name), Cells(a2loop_ctr, (a2name + 2))).Copy Destination:=Cells(a2loop_ctr, a1data)
        ElseIf Cells(a2loop_ctr, a2name) Like "Two" Then
            ActiveSheet.Range(Cells(a2loop_ctr, a2name), Cells(a2loop_ctr, (a2name + 2))).Copy Destination:=Cells(a2loop_ctr, a2data)
        ElseIf Cells(a2loop_ctr, a2name) Like "Three" Then
            ActiveSheet.Range(Cells(a2loop_ctr, a2name), Cells(a2loop_ctr, (a2name + 2))).Copy Destination:=Cells(a2loop_ctr, a3data)
        Else
            'Error message and exist in case the cell is invalid
            MsgBox "VALIDATION ERROR: Cell " & Replace(Replace(Cells(1, a2name).Address, "1", ""), "$", "") & a2loop_ctr & " does not contain a valid voter Name"
            Exit Sub
        End If


    Next a2loop_ctr
    For a3loop_ctr = 2 To LR
        'Statements to be executed inside the loop
        ' evaluate column H for value = One, Two or Three; copy data across to respective data ramge on the same row.
        If Cells(a3loop_ctr, a3name) Like "One" Then
            ActiveSheet.Range(Cells(a3loop_ctr, a3name), Cells(a3loop_ctr, (a3name + 2))).Copy Destination:=Cells(a3loop_ctr, a1data)
        ElseIf Cells(a3loop_ctr, a3name) Like "Two" Then
            ActiveSheet.Range(Cells(a3loop_ctr, a3name), Cells(a3loop_ctr, (a3name + 2))).Copy Destination:=Cells(a3loop_ctr, a2data)
        ElseIf Cells(a3loop_ctr, a3name) Like "Three" Then
            ActiveSheet.Range(Cells(a3loop_ctr, a3name), Cells(a3loop_ctr, (a3name + 2))).Copy Destination:=Cells(a3loop_ctr, a3data)
        Else
            'Error message and exist in case the cell is invalid
            MsgBox "VALIDATION ERROR: Cell " & Replace(Replace(Cells(1, a3name).Address, "1", ""), "$", "") & a3loop_ctr & " does not contain a valid voter Name"
            Exit Sub
        End If


    Next a3loop_ctr

    ' cut the data for One and paste it to column B
    ActiveSheet.Range(Cells(2, a1data), Cells(LR, a1data + 2)).Cut Destination:=Cells(2, a1name)

    ' cut the data for TWO and paste it to column E
    ActiveSheet.Range(Cells(2, a2data), Cells(LR, a2data + 2)).Cut Destination:=Cells(2, a2name)

    ' cut the data for THREE and paste it to column H
    ActiveSheet.Range(Cells(2, a3data), Cells(LR, a3data + 2)).Cut Destination:=Cells(2, a3name)

    ' Select cell B2
    Cells(2, 2).Select
End Sub

如何添加一名额外的选民

  1. 将名称计数更新为4
  2. 添加变量“ a4name”，并将其值设置为11
  3. 创建一个新变量'a4data'
  4. 将“ a1data”设置为主数据范围右侧任意位置的列号值。然后设置a2data = a1datat + 3，a3data = a2data + 3，a4data = a3data + 3。
  5. 根据a1loop，a2loop等的模式添加a4loop。

如果添加第5，第6选民，则遵循相同的方法。

如果您有很多文件，那么您可能还会发现此宏很方便。它使您可以浏览csv文件，打开文件，将数据插入工作表，然后将工作表重命名为文件名。

Sub ImportCSVVoting()

Dim vPath As Variant
Dim wb As Excel.Workbook
Dim ws As Excel.Worksheet

Set wb = Excel.ActiveWorkbook
Set ws = Excel.ActiveSheet

vPath = Application.GetOpenFilename("CSV (Comma Delimited) (*.csv),*.csv" _
, 1, "Select a file", , False)
''//Show the file open dialog to allow user to select a CSV file

If vPath = False Then Exit Sub
''//Exit macro if no file selected

Workbooks.OpenText Filename:=vPath, Origin:=xlMSDOS, StartRow:=1 _
    , DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, Comma:=True _
    , FieldInfo:=Array(Array(1, xlTextFormat), Array(2, xlTextFormat), _
    Array(3, xlTextFormat))
''//The fieldinfo array needs to be extended to match your number of columns

Columns.EntireColumn.AutoFit
''//Resize the columns

Sheets(1).Move Before:=wb.Sheets(1)
''//Move the data into the Workbook

Cells(1, 1).Select
''// Select cell A1

End Sub

答案 1 :(得分：0)

如果尚未拆分单元格，请在选择单元格的情况下运行此宏...我复制并粘贴了您所拥有的内容并进行了处理。

如果您已经将它们作为CSV导入到excel中并将其值拆分为自己的列，则还有其他一些方法。这有帮助吗？ VBA中确实有很多解决此类问题的方法。 

Sub SplitOneTwoThree()
    Dim Arr1 As Variant
    Dim I as long
    Dim K As long

    For I = 1 To Selection.Rows.Count
        Arr1 = Split(ActiveCell.Offset(I - 1, 0).Value, ",")
        For K = 1 To UBound(Arr1)
            If Arr1(K) = "One" Then
                ActiveCell.Offset(I - 1, 1) = Arr1(K)
                ActiveCell.Offset(I - 1, 2) = Arr1(K + 1)
                ActiveCell.Offset(I - 1, 3) = Arr1(K + 2)
                K = K + 2
            End If
            If Arr1(K) = "Two" Then
                ActiveCell.Offset(I - 1, 4) = Arr1(K)
                ActiveCell.Offset(I - 1, 5) = Arr1(K + 1)
                ActiveCell.Offset(I - 1, 6) = Arr1(K + 2)
                K = K + 2
            End If
            If Arr1(K) = "Three" Then
                ActiveCell.Offset(I - 1, 7) = Arr1(K)
                ActiveCell.Offset(I - 1, 8) = Arr1(K + 1)
                ActiveCell.Offset(I - 1, 9) = Arr1(K + 2)
                K = K + 2
            End If
        Next K
    Next I
End Sub

答案 2 :(得分：0)

下面的代码并不漂亮，但是它可以满足您的要求，包括Solution值。将“ Sheet1”更改为数据所在的工作表。

Set ws = Worksheets("Sheet1")
lRow = ws.Cells(Rows.Count, 2).End(xlUp).Row
Set rng = ws.Range("B2:B" & lRow)
Dim x As Long
Dim i As Long

For i = 1 To 2
    For x = 2 To lRow
        If Cells(x, "B").Value <> "One" Then
            Cells(x, "B").Resize(, 3).Copy
            Cells(x, "B").Offset(, 9).Insert Shift:=xlToRight
            Cells(x, "B").Resize(, 3).Delete Shift:=xlToLeft
        End If
    Next
Next i

For x = 2 To lRow
    If Cells(x, "E").Value <> "Two" Then
        Cells(x, "E").Resize(, 3).Copy
        Cells(x, "E").Offset(, 6).Insert Shift:=xlToRight
        Cells(x, "E").Resize(, 3).Delete Shift:=xlToLeft
    End If
Next
相关问题
最新问题