VBA批量导入CSV文件、批量改数据标题、批量做数据透视表

本教程介绍如何使用VB脚本批量导入CSV文件到Excel的不同工作表中,并为每个工作表创建数据透视表进行汇总分析。

摘要生成于 C知道 ,由 DeepSeek-R1 满血版支持, 前往体验 >

'本代码是利用VB批量导入CSV文件,并且每个文件存为一个Sheet
'前提是所有CSV文件和运行宏的这个文件在同一个文件夹
'不智能的地方是我预先知道有多少个CSV文件,然后把文件名改为1.csv,2.csv,...
'所以循环的时候总数是写死的
'另外我的数据导入处理方式是:文件包含标题且按逗号隔开,若不一样更改参数就行了
'下面就附上所有完整代码:
'主函数
Sub main()
  Dim startNum,endNum as Integer
  startNum = 1
  endNum = 5
  Call addSheet_openFile(startNum,endNum)
  Call changeName(startNum,endNum)
  Call perspectiveTable(startNum,endNum)
  ActiveWorkbook.Save
End Sub

'批量导入CSV
Sub addSheet_openFile(startNum,endNum)
  Dim i As Integer
  Dim NewSheet As Worksheet
  For i = startNum To endNum
    ActiveSheet.Name = "Sheet" & CStr(i)
    With ActiveSheet.QueryTables.Add(Connection:="TEXT;D:\xlh\201801\优惠券统计\" & CStr(i) & ".csv" _
        , Destination:=Range("$A$1"))
        .Name = CStr(i)
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 936
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(2, 2, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    If i < endNum Then
      Set NewSheet = Worksheets.Add(after:=ActiveSheet)
    End If
  Next
End Sub


'批量导入之后需要同意更改所有Sheet的数据标题
Sub changeName(startNum,endNum)
  Dim i As Integer
  For i = startNum To endNum
    Sheets("Sheet" + CStr(i)).Select
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "userno"
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "cid"
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "count"
  Next
End Sub

'然后就需要对每个sheet做数据透视表进行分类统计
Sub perspectiveTable(startNum,endNum)
  Dim i As Integer
  Dim sheetName As String
  For i = startNum To endNum
    sheetName = "Sheet" & CStr(i)
    Sheets(sheetName).Select
    Columns("A:C").Select
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        sheetName & "!R1C1:R1048576C3", Version:=6).CreatePivotTable TableDestination:= _
        sheetName & "!R1C6", TableName:="数据透视表2", DefaultVersion:=6
    Sheets(sheetName).Select
    Cells(1, 6).Select
    ActiveWorkbook.ShowPivotTableFieldList = True
    With ActiveSheet.PivotTables("数据透视表2").PivotFields("userno")
        .Orientation = xlRowField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("数据透视表2").PivotFields("cid")
        .Orientation = xlColumnField
        .Position = 1
    End With
    ActiveSheet.PivotTables("数据透视表2").AddDataField ActiveSheet.PivotTables("数据透视表2" _
        ).PivotFields("count"), "求和项:count", xlSum
    Columns("A:C").Select  '删除原始数据
    Selection.Delete Shift:=xlToLeft
  Next
End Sub

评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包

打赏作者

Trisyp

你的鼓励将是我创作的最大动力

¥1 ¥2 ¥4 ¥6 ¥10 ¥20
扫码支付:¥1
获取中
扫码支付

您的余额不足,请更换扫码支付或充值

打赏作者

实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值