在宏中组合列

时间:2016-03-26 22:07:43

标签: excel vba excel-vba macros

我知道这个主题有很多不同的方式。我今天才开始关注vba和宏,但我找不到或调整我发现的任何解决方案。

我在4个不同的excel文件中提取4列数据,每个文件中包含大约500列和2-4k行数据。

我想出了如何使用以下(不优雅的)解决方案将感兴趣的列编译到单个excel文件中(见下文)。

我希望有人可以指出我如何获取这16列并将其更改为4列(或者如果有人能够解释如何将数据放到4列中,这也很棒)。

谢谢!

Sub Macro2()

' Macro2 Macro


    Workbooks.Open Filename:="[path]"
    Workbooks.Open Filename:="[path]"
    Workbooks.Open Filename:="[path]"
    Workbooks.Open Filename:="[path]"

    Workbooks("Stroop_Distressing_A_out.csv").activate
        Sheets("Stroop_Distressing_A_out.csv").select
            Range("GL:GL, HP:HP, IJ:IJ, IS:IS").copy
    Workbooks("Merge Excel Data Macro1.xlsm").activate
        Sheets("Sheet1").select
            Range("A:D").select
            ActiveSheet.Paste

    Workbooks("Stroop_Distressing_B_out.csv").Activate
    Sheets("Stroop_Distressing_B_out.csv").Select
            Range("GL:GL, HP:HP, IK:IK, IT:IT").Copy
    Workbooks("Merge Excel Data Macro1.xlsm").Activate
        Sheets("Sheet1").Select
              Range("E:H").Select
    ActiveSheet.Paste


    Workbooks("Stroop_Distressing_C_out.csv").activate
        Sheets("Stroop_Distressing_C_out.csv").select
            Range("DV:DV, EZ:EZ, FU:FU, GD:GD").copy
    Workbooks("Merge Excel Data Macro1.xlsm").activate
        Sheets("Sheet1").select     
    Workbooks("Merge Excel Data Macro1.xlsm").Activate
        Sheets("Sheet1").Select
              Range("I:L").Select
    ActiveSheet.Paste

    Workbooks("Stroop_Distressing_D_out.csv").activate
        Sheets("Stroop_Distressing_D_out.csv").select
            Range("GL:GL, HP:HP, IK:IK, IT:IT").copy
    Workbooks("Merge Excel Data Macro1.xlsm").activate
        Sheets("Sheet1").select     
        Workbooks("Merge Excel Data Macro1.xlsm").Activate
        Sheets("Sheet1").Select
              Range("M:P").Select
    ActiveSheet.Paste

End Sub

1 个答案:

答案 0 :(得分:0)

如果您的VBA宏成功完成,则可以使用以下Sub执行其余任务:

Sub AggregateColumns()
    Dim wsSource As Worksheet
    Dim wsTarget As Worksheet
    Dim maxRowSource As Integer
    Dim maxRowTarget As Integer

    Set wsSource = Sheets("Sheet1")
    Set wsTarget = Sheets("Sheet2")

    maxRowSource = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row
    maxRowTarget = wsTarget.Cells(wsTarget.Rows.Count, "A").End(xlUp).Row
    wsSource.Range("A1:D" & maxRowSource).Copy Destination:=wsTarget.Range("A1")

    maxRowSource = wsSource.Cells(wsSource.Rows.Count, "E").End(xlUp).Row
    maxRowTarget = wsTarget.Cells(wsTarget.Rows.Count, "A").End(xlUp).Row
    wsSource.Range("E1:H" & maxRowSource).Copy Destination:=wsTarget.Range("A" & maxRowTarget + 1)

    maxRowSource = wsSource.Cells(wsSource.Rows.Count, "I").End(xlUp).Row
    maxRowTarget = wsTarget.Cells(wsTarget.Rows.Count, "A").End(xlUp).Row
    wsSource.Range("I1:L" & maxRowSource).Copy Destination:=wsTarget.Range("A" & maxRowTarget + 1)

    maxRowSource = wsSource.Cells(wsSource.Rows.Count, "M").End(xlUp).Row
    maxRowTarget = wsTarget.Cells(wsTarget.Rows.Count, "A").End(xlUp).Row
    wsSource.Range("M1:P" & maxRowSource).Copy Destination:=wsTarget.Range("A" & maxRowTarget + 1)

End Sub

希望这会有所帮助。