ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

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

[求助] 再次请桥玄霜老师和各位老师,Set r1 = rng. Find(Arr(i, j), , , 1) 这里显示..

[复制链接]

TA的精华主题

TA的得分主题

发表于 2017-7-20 09:27 | 显示全部楼层 |阅读模式
本帖最后由 lwfzjs 于 2017-7-20 10:07 编辑

蓝桥玄霜老师您好:
  你在http://club.excelhome.net/thread-1358098-2-1.html里帮我编的VBA   我在表格中Set d = CreatObject("Scripting. Dictonary")运行出现了问题, 麻烦你帮忙看看 我抄写过程出现了什么问题 Set r1 = rng. Find(Arr(i, j), , , 1) 这里显示有问题

sub test()
Dim arr, i&, rng As Range, r1, j&, aa, a, mx, n&
Dim d, k, t, d1, k1, t1, Brr, r%, Arr1(), rr%, Arr2()
Set d = CreatObject("Scripting. Dictonary")
Set d1 = CreatObject("Scripting. Dictonary")
Sheet1. Activate
[aq3:bg5000]. ClearContents
Arr = [b1].CurrentRegion
Brr = [i1].CurrentRegion
for i =3 TO UBound(Arr)
    Set rag = Cells(i, 9). Resize(1, 33)
    For j = 1 To UBound(Arr, 2)
        Set r1 = rng. Find(Arr(i, j), , , 1)
        d(r1. Coumn - 8) = ""
    Next
    k = d.keys: r = 0: rr = 0
    ReDim a(33)
    For j = O To UBound(k)
        a(K(j)) = k(j)
    Next
    For j = O To UBound(a)
        If a(j) <> "" Then
            r = r + 1
            ReDim Preserve Arr1(1 To r)
            Arr1(r) = a(j)
        End If
   Next
   For j = 1 To r
       If j = 1 Then aa = Arr1(j) - 1 Else aa = Arr1(j) - Arr(j - 1) - 1
       rr = rr + 1
       ReDim Preserve Arr2(1 To rr)
       Arr2(rr) = aa
  Next
  Arr2(1) = Arr2(1) + 33 - Arr1(r)
  For j = 1 To r
      d1(Arr2(j)) = d1(Arr2(j)) & j & ","
  Next
  k1 = d1. keys: t1 = d1. items: col = 42
  mx = Application. Max(Arr2)
  n = Application. Match(mx, k1, 0) - 1
  t = t1(n)
  t = left(t, Len(t) - 1)
  If InStr(t, ",") Then
      aa = Split(t, ",")
      For j = O To UBound(aa)
          Call tb(i, Val(aa(j)), r, Arrl, Brr)
      Next
   Else
      Call tb(i, Val(t), r, Arr1, Brr)
   End IF
    d.RemoveALL
    d1.RemoveALL
Next
End Sub


sub tb(i, n, r, Arr1, Brr)
Dim j&
    If n <> 1 Then
       For j = Arr(n - 1) + 1 To Arr1(n) - 1
          col = col + 1
          cells(i,col) = Format(Brr(i, j), "00")
       Next
    Else
       If Arr1(r) <> 33 Then
        For j = Arr1(r) + 1 To 33
            col = col + 1
            Cells(i, col) = Format(Brr(i, j), "00")
        Next
        End If
        if Arr1(1) <> 1 Then
        For j = 1 To Arr1(1) - 1
            col = col + 1
            Cells(i, col) = Format(Brr(i, j), "00")
        Next
        End If
    End If

End sub

TA的精华主题

TA的得分主题

发表于 2017-7-20 09:34 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
Scripting.Dictionary

TA的精华主题

TA的得分主题

发表于 2017-7-20 09:36 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2017-7-20 09:39 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2017-7-20 09:40 | 显示全部楼层

TA的精华主题

TA的得分主题

 楼主| 发表于 2017-7-20 09:50 | 显示全部楼层
本帖最后由 lwfzjs 于 2017-7-20 09:56 编辑
蓝桥玄霜 发表于 2017-7-20 09:39
Set d = CreateObject("Scripting.Dictionary")

12%TLL%PMAH$P2WADLO6T%V.png 蓝桥玄霜老师:  修改以后, 运行出现新的问题  麻烦您再次指教  Set r1 = rng. Find(Arr(i, j), , , 1)  这里显示有问题

TA的精华主题

TA的得分主题

发表于 2017-7-21 08:30 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
抄错了:Set rag = Cells(i, 9). Resize(1, 33)
是 Set rng=
请仔细核对代码。
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

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

GMT+8, 2024-3-29 17:40 , Processed in 0.031528 second(s), 10 queries , Gzip On, Redis On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

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

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

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