VBA学习之关于数据透视表的应用

工作中很多地方需要同时处理多个数据表,而且用数据透视表进行排版,排序,计算字段,一个一个的做非常累,这里给出批量处理的方法。

 

学习VBA之前最好懂一点点VB的基础知识,因为里面的很多语法问题都是由VB来的。

Sub 出库数据一键生成数据透视表()
'先判定sheet表名称是否正确
 If ActiveSheet.name = "出库" Then
 MsgBox "这个是出库数据,请继续!!"
 
Dim name As String
Dim arr As Variant
Dim count, n As Long

'注意:此程序专门用于ABC出库数据,sheet表名称必须为"出库(发货)"

'格式必须为 业务员-日期-购货单位-产品名称-规格型号-单位-基本单位实发数量-件数

'程序会自动筛选你想要的产品的信息并建立新的sheet表,自动生成数据透视表。

'=============================================
'=          程序作者:clyzly                   =
'=       有问题联系:QQ76601149               =
'=============================================
'Application.ScreenUpdating = False

'   Cells.Replace What:="(黑龙江)", Replacement:="", LookAt:=xlPart, SearchOrder _
'        :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

    Worksheets.Add after:=ActiveSheet
    ActiveSheet.name = "出库数据汇总总表"
       
    '自动生成数据透视表
    
    name = "出库数据汇总总表"  '给要建立的数据透视表命个名字

        ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=Worksheets("出库").UsedRange, _
        Version:=xlPivotTableVersion10).CreatePivotTable TableDestination:=Range("A3"), TableName:="name", DefaultVersion:=xlPivotTableVersion10
        
        ActiveWorkbook.ShowPivotTableFieldList = True
                With ActiveSheet.PivotTables("name").PivotFields("产品名称")
                    .Orientation = xlColumnField
                    .Position = 1
                End With
                With ActiveSheet.PivotTables("name").PivotFields("业务员")
                    .Orientation = xlRowField
                    .Position = 1
                End With
'                With ActiveSheet.PivotTables("name").PivotFields("购货单位")
'                    .Orientation = xlRowField
'                    .Position = 3
'                End With
    ActiveSheet.PivotTables("name").AddDataField ActiveSheet.PivotTables("name").PivotFields("件数"), "求和项:件数", xlSum
    ActiveSheet.PivotTables("name").PivotFields("业务员").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
    
    With ActiveSheet.PivotTables("name").PivotFields("业务员")
        .PivotItems("XX").Visible = False
        .PivotItems("XX").Visible = False
    End With
    
        For Each pvtitem In ActiveSheet.PivotTables("name").PivotFields("产品名称").PivotItems
          If pvtitem.name = "XXA" Then
             pvtitem.Visible = True
                ActiveSheet.PivotTables("name").PivotFields("产品名称").PivotItems("XXA").Position = 1
             ElseIf pvtitem.name = "XXB" Then
             pvtitem.Visible = True
                ActiveSheet.PivotTables("name").PivotFields("产品名称").PivotItems("XXB").Position = 2
             ElseIf pvtitem.name = "XXC" Then
             pvtitem.Visible = True
                ActiveSheet.PivotTables("name").PivotFields("产品名称").PivotItems("XXC").Position = 3
             ElseIf pvtitem.name = "XXD" Then
             pvtitem.Visible = True
                ActiveSheet.PivotTables("name").PivotFields("产品名称").PivotItems("XXD").Position = 4
             ElseIf pvtitem.name = "XXE" Then
             pvtitem.Visible = True
                ActiveSheet.PivotTables("name").PivotFields("产品名称").PivotItems("XXE").Position = 5
             ElseIf pvtitem.name = "XXE" Then
             pvtitem.Visible = True
                ActiveSheet.PivotTables("name").PivotFields("产品名称").PivotItems("XXF").Position = 6
             ElseIf pvtitem.name = "XXF" Then
             pvtitem.Visible = True
                ActiveSheet.PivotTables("name").PivotFields("产品名称").PivotItems("XXG").Position = 7
             ElseIf pvtitem.name = "XXG" Then
             pvtitem.Visible = True
                ActiveSheet.PivotTables("name").PivotFields("产品名称").PivotItems("XXH").Position = 8
             ElseIf pvtitem.name = "XXH" Then
             pvtitem.Visible = True
                ActiveSheet.PivotTables("name").PivotFields("产品名称").PivotItems("XXJ").Position = 9
             ElseIf pvtitem.name = "XXJ" Then
             pvtitem.Visible = True
                ActiveSheet.PivotTables("name").PivotFields("产品名称").PivotItems("XXK").Position = 10
             ElseIf pvtitem.name = "XXK" Then
             pvtitem.Visible = True
                ActiveSheet.PivotTables("name").PivotFields("产品名称").PivotItems("XXL").Position = 11
             ElseIf pvtitem.name = "XXE" Then
             pvtitem.Visible = True
                ActiveSheet.PivotTables("name").PivotFields("产品名称").PivotItems("XXE").Position = 12
             ElseIf pvtitem.name = "XXL" Then
             pvtitem.Visible = True
                ActiveSheet.PivotTables("name").PivotFields("产品名称").PivotItems("XXL).Position = 13
          Else
             pvtitem.Visible = False
          End If
        Next


Application.ScreenUpdating = True

 Else
 MsgBox "sheet表名称不对吧????一定得是 出库"
 End If
 
End Sub

做VBA首先得会录制宏,不会就F1,会大大提高学习效果。

Application.ScreenUpdating  这个是代表是否使用屏幕刷新,处理大数据的时候最好将其关闭,否则你会卡死的。
其他的自己摸索摸索就会了

转载于:https://www.cnblogs.com/clyzly/p/4253933.html

  • 0
    点赞
  • 6
    收藏
    觉得还不错? 一键收藏
  • 0
    评论
SQL+数据透视表+VBA 使数据透视表走向更灵活,更智能,更适用。 这个是我和师傅一撇首度合作,他提供了文件并提出了要求,我帮他实现其效果 下面从几个方面解释一下: 1、能 一个源文件和一个通过用SQL查询生成的数据透视表 将源文件拖到电脑的任意位置,甚至将文件名也改掉,用VBA配上代码和窗体找到文件,数据透视表仍然能够正常工作 2、套用 现在来讲讲怎么使做出来的东东适应大家的需要 2、1 用OLE DB窗口引用工作表或写SQL语句,因为用这个方法同VBA相通,copy下来代码区的的语句 2、2 打开透视表文件,将透视表中的字段全部拖出来,也就是变成一个空数据透视表。 右击下面工作表图标 或者 工具》宏》visual basic 编辑器,点击模块看到代码区 2、3 将2、1步骤copy的语句commandtext的数据Array中的引号中 .CommandText = Array(" ") 可能不同版本会有一些差别,同时SQL语句中如果添加了文本生成新字段,双引号要成对翻倍 如:"出库" AS 表单选项 要改成 ""出库"" AS 表单选项 2、4 语句太长的处理:在代码区如果你想好看一些,你可以插入“ _”来换行,当然不能插在一个单词或自动名等中间。 2、5 将文件存盘,重新打开就会有了数据,你可以将字段拖入数据透视表中,创建你自己的数据透视表, 2、6 这样文件就可以使用,相信VBA的引导不用教就可以交给别人使用了 下面附上代码,包含3个区: 1、 工作簿去,打开文件时工作 Private Sub Workbook_Open() Dim OP If Dir(Sheets("path").Range("A1")) = "" Then OP = MsgBox("源文件已被移走,请选择下列选项" + Chr(10) + "1、选择是,重新输入文件全名" + Chr(10) + "2、选择否,打开原有的数据透视表" + Chr(10) + "3、选择取消,关闭文件", vbYesNoCancel, "Scarlett温馨提示") If OP = vbYes Then UserForm1.Show End If If OP = vbNo Then ActiveWorkbook.Close True End If If OP = vbCancel Then Exit Sub End If Else Call refreshpv End If End Sub 2、窗体区,实现文件的查找 Private Sub CommandButton1_Click() Dim fopen As FileDialog Set fopen = Application.FileDialog(msoFileDialogFilePicker) fopen.Show TextBox1.Value = fopen.SelectedItems(1) Set fopen = Nothing End Sub Private Sub CommandButton2_Click() If InStr(TextBox1.Value, ".") > 0 Then Sheets("path").Range("A1") = TextBox1.Value Call refreshpv unload me Else MsgBox "文件名要带路径含后缀的文件名", "Scarlett_88温馨提示" TextBox1.SetFocus End If End Sub Private Sub CommandButton3_Click() Unload Me End Sub Private Sub TextBox1_Change() End Sub Private Sub UserForm_Activate() End Sub Private Sub UserForm_Click() TextBox1.Value = Sheets("path").Range("A1") End Sub 3、模块区,实现SQL语句的地址更新和刷新数据透视表数据源 Sub refreshpv() With ActiveSheet.PivotTables("数据透视表1").PivotCache .Connection = Array( _ "OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;User ID=Admin;Data Sourc

“相关推荐”对你有帮助么?

  • 非常没帮助
  • 没帮助
  • 一般
  • 有帮助
  • 非常有帮助
提交
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

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

余额充值