设为首页收藏本站
开启辅助访问

Excel精英培训网

 找回密码
 注册
Excel精英培训网»论坛 › Excel 求助区 › Excel VBA开发 › VBA统计
数据透视表40+个常用小技巧，让你一次学会！
返回列表 发新帖
查看: 3234|回复: 9

[已解决]VBA统计

[复制链接]
cyj153
发表于 2015-4-23 11:55 | 显示全部楼层 |阅读模式
工作中常用的Excel函数公式，全印在一张超大鼠标垫上
本帖最后由 cyj153 于 2015-4-24 07:30 编辑

统计.zip (5.5 KB, 下载次数: 35)
excel精英培训的微信平台，每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
回复

使用道具 举报

工作中最常用的函数公式，全印在一张超大的鼠标垫上
发表于 2015-4-23 12:04 | 显示全部楼层
工作中常用的Excel函数公式，全印在一张超大鼠标垫上
  1. Sub test()
  2.     Dim Dic As Object
  3.     Dim arr, brr
  4.     Dim Iar As Integer, Ibr As Integer, Icount As Integer
  5.     Set Dic = CreateObject("scripting.dictionary")
  6.     arr = Range("e5:e" & Cells(Rows.Count, 5).End(3).Row)
  7.     For Iar = 1 To UBound(arr)
  8.         Dic(arr(Iar, 1)) = ""
  9.     Next
  10.     brr = Range("i5:i" & Cells(Rows.Count, 5).End(3).Row)
  11.     For Ibr = 1 To UBound(brr)
  12.         If brr(Ibr, 1) <> "" Then
  13.             Icount = Icount + 1
  14.         End If
  15.     Next
  16.     Sheets("Sheet3").Cells(Rows.Count, "g").End(3).Offset(1, 0) = Dic.Count
  17.     Sheets("Sheet3").Cells(Rows.Count, "f").End(3).Offset(1, 0) = Icount
  18. End Sub
复制代码
COPY代码吧。测试过，没问题，希望能解决你的烦恼，要是解决了就给个最佳以示鼓励吧
回复

使用道具 举报

cyj153
 楼主| 发表于 2015-4-23 12:17 | 显示全部楼层
工作中最常用的Excel函数公式，全印在一张鼠标垫上
Excel学徒123 发表于 2015-4-23 12:04
COPY代码吧。测试过，没问题，希望能解决你的烦恼，要是解决了就给个最佳以示鼓励吧

老师：请问其他列的数据能否引用或统计。如D，E，H列的数据。
回复

使用道具 举报

发表于 2015-4-23 12:33 | 显示全部楼层
本帖最后由 Excel学徒123 于 2015-4-23 12:37 编辑
cyj153 发表于 2015-4-23 12:17
老师：请问其他列的数据能否引用或统计。如D，E，H列的数据。

可以啊，看你具体的规则，还有问题一次说完，不要挤牙膏一样
回复

使用道具 举报

cyj153
 楼主| 发表于 2015-4-23 15:08 | 显示全部楼层
Excel学徒123 发表于 2015-4-23 12:33
可以啊，看你具体的规则，还有问题一次说完，不要挤牙膏一样

谢谢老师就这些！
回复

使用道具 举报

发表于 2015-4-23 15:36 | 显示全部楼层
cyj153 发表于 2015-4-23 15:08
谢谢老师就这些！

怎么个统计法呢？
回复

使用道具 举报

发表于 2015-4-23 16:03 | 显示全部楼层
  1. Sub test()
  2.     Dim Dic As Object, Dic1 As Object, Dic2 As Object
  3.     Dim arr, brr, crr, drr
  4.     Dim Iar As Integer, Ibr As Integer, Icount As Integer, _
  5.         Icr As Integer, Idr As Integer
  6.     Set Dic = CreateObject("scripting.dictionary")
  7.     Set Dic1 = CreateObject("scripting.dictionary")
  8.     Set Dic2 = CreateObject("scripting.dictionary")
  9.     arr = Range("e5:e" & Cells(Rows.Count, 5).End(3).Row)
  10.     For Iar = 1 To UBound(arr)
  11.         Dic(arr(Iar, 1)) = ""
  12.     Next
  13.     brr = Range("i5:i" & Cells(Rows.Count, 5).End(3).Row)
  14.     For Ibr = 1 To UBound(brr)
  15.         If brr(Ibr, 1) <> "" Then
  16.             Icount = Icount + 1
  17.         End If
  18.     Next
  19.     crr = Range("c5:c" & Cells(Rows.Count, 5).End(3).Row)
  20.     For Icr = 1 To UBound(brr)
  21.         Dic1(crr(Icr, 1)) = ""
  22.     Next
  23.     drr = Range("d5:d" & Cells(Rows.Count, 5).End(3).Row)
  24.     For Idr = 1 To UBound(brr)
  25.         Dic2(drr(Idr, 1)) = ""
  26.     Next
  27.     Sheets("Sheet3").Cells(Rows.Count, "g").End(3).Offset(1, 0) = Dic.Count
  28.     Sheets("Sheet3").Cells(Rows.Count, "f").End(3).Offset(1, 0) = Icount
  29.     Sheets("Sheet3").Cells(Rows.Count, "d").End(3).Offset(1, 0).Resize(Dic1.Count) = Dic1.keys
  30.     Sheets("Sheet3").Cells(Rows.Count, "e").End(3).Offset(1, 0).Resize(Dic2.Count) = Dic2.keys
  31. End Sub
复制代码
你那个其他我就不晓得是啥意思了，，，
回复

使用道具 举报

发表于 2015-4-23 21:06 | 显示全部楼层    本楼为最佳答案   
  1. Sub test()
  2.     Dim Dic As Object, Dic1 As Object, Dic2 As Object
  3.     Dim arr, brr, crr, drr
  4.     Dim Iar As Integer, Ibr As Integer, Icount As Integer, _
  5.         Icr As Integer, Idr As Integer, i As Integer
  6.     Set Dic = CreateObject("scripting.dictionary")
  7.     Set Dic1 = CreateObject("scripting.dictionary")
  8.     Set Dic2 = CreateObject("scripting.dictionary")
  9.     arr = Range("e5:e" & Cells(Rows.Count, 5).End(3).Row)
  10.     For Iar = 1 To UBound(arr)
  11.         Dic(arr(Iar, 1)) = ""
  12.     Next
  13.     brr = Range("i5:i" & Cells(Rows.Count, 5).End(3).Row)
  14.     For Ibr = 1 To UBound(brr)
  15.         If brr(Ibr, 1) <> "" Then
  16.             Icount = Icount + 1
  17.         End If
  18.     Next
  19.     crr = Range("c5:c" & Cells(Rows.Count, 5).End(3).Row)
  20.     For Icr = 1 To UBound(brr)
  21.         Dic1(crr(Icr, 1)) = ""
  22.     Next
  23.     drr = Range("d5:d" & Cells(Rows.Count, 5).End(3).Row)
  24.     For Idr = 1 To UBound(brr)
  25.         Dic2(drr(Idr, 1)) = ""
  26.     Next
  27.     Sheets("Sheet3").Cells(Rows.Count, "g").End(3).Offset(1, 0) = Dic.Count
  28.     Sheets("Sheet3").Cells(Rows.Count, "f").End(3).Offset(1, 0) = Icount
  29.     Sheets("Sheet3").Cells(Rows.Count, "d").End(3).Offset(1, 0).Resize(Dic1.Count) = Dic1.keys
  30.     Sheets("Sheet3").Cells(Rows.Count, "e").End(3).Offset(1, 0).Resize(Dic2.Count) = Dic2.keys
  31.     For i = 1 To Sheets("Sheet3").Cells(Rows.Count, 5).End(3).Row
  32.        If Sheets("Sheet3").Cells(i, 6) > Sheet3.[b1] Then
  33.           Sheets("Sheet3").Cells(i, 8) = Sheet3.[b1]
  34.        Else
  35.           Sheets("Sheet3").Cells(i, 8) = Sheet3.[b1] - 1
  36.        End If
  37.     Next i
  38. End Sub
复制代码
直接放进去就行了啊，但是我不知道你具体的规则，所以只有猜了
回复

使用道具 举报

cyj153
 楼主| 发表于 2015-4-23 23:37 | 显示全部楼层
Excel学徒123 发表于 2015-4-23 21:06
直接放进去就行了啊，但是我不知道你具体的规则，所以只有猜了

问题：当表2“数据7”的个数和小于sheet3.[b1]时，表3“其他”列等于sheet3.[b1]。否则，等于表2“数据7”的个数和－1。不知这样表述是否理解。谢谢指导！
回复

使用道具 举报

cyj153
 楼主| 发表于 2015-4-24 07:29 | 显示全部楼层
本帖最后由 cyj153 于 2015-4-24 07:31 编辑
Excel学徒123 发表于 2015-4-23 21:06
直接放进去就行了啊，但是我不知道你具体的规则，所以只有猜了



谢谢老师：
Sub test()
   Dim Dic As Object, Dic1 As Object, Dic2 As Object
   Dim arr, brr, crr, drr
   Dim Iar As Integer, Ibr As Integer, Icount As Integer, _
      Icr As Integer, Idr As Integer, i As Integer
   Set Dic = CreateObject("scripting.dictionary")
   Set Dic1 = CreateObject("scripting.dictionary")
   Set Dic2 = CreateObject("scripting.dictionary")
   Set Dic3 = CreateObject("scripting.dictionary")
   arr = Range("e5:e" & Cells(Rows.Count, 5).End(3).Row)
   For Iar = 1 To UBound(arr)
      Dic(arr(Iar, 1)) = ""
   Next
   brr = Range("i5:i" & Cells(Rows.Count, 5).End(3).Row)
   For Ibr = 1 To UBound(brr)
      If brr(Ibr, 1) <> "" Then
         Icount = Icount + 1
         If Icount > Sheet3.[b1] Then
            Icount2 = Sheet3.[b1]
         Else
            Icount2 = Icount - 1
         End If
      End If
   Next
   crr = Range("c5:c" & Cells(Rows.Count, 5).End(3).Row)
   For Icr = 1 To UBound(brr)
      Dic1(crr(Icr, 1)) = ""
   Next
   drr = Range("d5:d" & Cells(Rows.Count, 5).End(3).Row)
   For Idr = 1 To UBound(brr)
      Dic2(drr(Idr, 1)) = ""
   Next
   Sheets("Sheet3").Cells(Rows.Count, "g").End(3).Offset(1, 0) = Dic.Count
   Sheets("Sheet3").Cells(Rows.Count, "f").End(3).Offset(1, 0) = Icount
   Sheets("Sheet3").Cells(Rows.Count, "h").End(3).Offset(1, 0) = Icount2
   Sheets("Sheet3").Cells(Rows.Count, "d").End(3).Offset(1, 0).Resize(Dic1.Count) = Dic1.keys
   Sheets("Sheet3").Cells(Rows.Count, "e").End(3).Offset(1, 0).Resize(Dic2.Count) = Dic2.keys
End Sub
回复

使用道具 举报

返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-5-20 01:58 , Processed in 0.437732 second(s), 10 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表