ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 效率神器,一键搞定繁琐工作
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
让更多数据处理,一键完成 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 488|回复: 7

[已解决] 请帮看下,这个循环应该怎么写呢

[复制链接]

TA的精华主题

TA的得分主题

发表于 2023-5-19 15:39 | 显示全部楼层 |阅读模式
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
本帖最后由 zldlsdz 于 2023-5-19 23:14 编辑

Sub 统计()
Dim i%, h%, j%, k%, arr, brr
    arr = Sheet2.Range("A2:HJ184")
    brr = Sheet1.Range("B2:Hk182")
    h = Sheet2.Range("A2").CurrentRegion.Columns.Count
        For k = 1 To h
            Sheet1.Cells(2, k + 2) = Sheet2.Cells(2, k)
            For j = 1 To UBound(brr)
            If arr(j + 2, k) = brr(k, 1) Then
                brr(j + 2, k + 2) = 1
            End If
        Next j
    Next k
End Sub
想实现:1.数据库里面第二行的数据复制到统计表的C2之后,
             2.如果数据库里面每列人名单与统计表B列的名单匹配后,在相对应的列填“1”,不存在填“0”。
以上是自己写的一个,遇到的问题是:循环与数组大小不匹配,下界越标;查找是否存在不太会写。
请帮帮忙!

焊轨车间“沈铁在线”阅读统计(VBA).rar

67.85 KB, 下载次数: 8

TA的精华主题

TA的得分主题

 楼主| 发表于 2023-5-19 19:22 | 显示全部楼层
循环的对应关系好像没弄明白,求大神指点。

TA的精华主题

TA的得分主题

发表于 2023-5-19 20:32 | 显示全部楼层
1、发现有同名的,其次,最后的统计数据怎么来的?

帮修改了一下,将统计表独立提取出来,选择文件进行统计明细,以免下次还要复制粘贴。汇总的自己搞一下吧,外人不确定
字典嵌套好搞一点。

TA的精华主题

TA的得分主题

发表于 2023-5-19 20:33 | 显示全部楼层
新手路过,不包售后

焊轨车间“沈铁在线”阅读统计(VBA).rar

260.66 KB, 下载次数: 2

TA的精华主题

TA的得分主题

 楼主| 发表于 2023-5-19 21:28 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
shiruiqiang 发表于 2023-5-19 20:33
新手路过,不包售后

字典还是比较蒙的状态。且顺序变了,收起来慢慢研究。但还是要表示感谢!!

TA的精华主题

TA的得分主题

发表于 2023-5-19 21:40 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
供参考……
微信截图_20230519213908.png

TA的精华主题

TA的得分主题

发表于 2023-5-19 21:40 | 显示全部楼层
  1. Sub 统计()
  2. Dim i%, j%, arr
  3. Set d = CreateObject("Scripting.Dictionary")
  4.     With Sheets("数据库")
  5.         arr = .[a2].CurrentRegion
  6.         For i = 3 To UBound(arr)
  7.             For j = 1 To UBound(arr, 2)
  8.                 d(arr(i, j) & "|" & arr(1, j)) = ""
  9.             Next
  10.         Next
  11.     End With
  12.     With Sheets("统计表")
  13.         arr = .[b2:hl181]
  14.         For i = 2 To UBound(arr)
  15.             For j = 2 To UBound(arr, 2)
  16.                 s = arr(i, 1) & "|" & arr(1, j)
  17.                 If d.exists(s) Then
  18.                     arr(i, j) = 1
  19.                 Else
  20.                     arr(i, j) = 0
  21.                 End If
  22.             Next
  23.         Next
  24.     .[b2].Resize(UBound(arr, 1), UBound(arr, 2)) = arr
  25.     End With
  26. Set d = Nothing
  27. End Sub
复制代码

TA的精华主题

TA的得分主题

 楼主| 发表于 2023-5-19 22:10 来自手机 | 显示全部楼层
tel3033 发表于 2023-5-19 21:40
供参考……

感谢感谢!
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-11-16 08:50 , Processed in 0.045148 second(s), 11 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

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