ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

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

[求助] 数据定义类型不匹配

[复制链接]

TA的精华主题

TA的得分主题

发表于 2020-3-7 13:02 | 显示全部楼层 |阅读模式
各位大神,我想做一个通过关键词查找对应字段的程序,但是不知道是不是数组定义有问题,运行时不是提示数据类型不匹配,就是提醒“ subscript out of range”。代码放上,想找下问题出在哪儿。
  1. Private Sub Worksheet_Change(ByVal Target As Range)

  2. If Target.Address <> "$L$2" Then Exit Sub
  3.     check = MsgBox("Do you want to create E4 APPLICATION FILE, Continue? Yes/Not", vbYesNo)
  4.     If check = vbYes Then
  5.         '***********定义************
  6.         Dim Project_No As String
  7.         Dim Reg(), Reg_tem(), Item(), Veh_Type(), Disc(), New_or_Not(), Exten_or_Not(), Test_or_Not() 'As Object
  8.         Dim arr(), brr()
  9.         Dim ws1 As Worksheet
  10.         
  11.         Dim i, j, k, b, m As Integer ' n
  12.    
  13.         '******************************
  14.         Project_No = Range("L2").Value '给project No赋值
  15.      
  16.      '**********定义字典********************
  17.         Sheets("Sheet2").Activate
  18.         Set ws1 = ThisWorkbook.Worksheets("sheet2")
  19.         With ws1
  20.         Dim New_Cer, Ext_Cer, Te_, IT As Object
  21.         Set New_Cer = CreateObject("Scripting.Dictionary")
  22.         Set Ext_Cer = CreateObject("Scripting.Dictionary")
  23.         Set Te_ = CreateObject("Scripting.Dictionary")
  24.         Set IT = CreateObject("Scripting.Dictionary")
  25.         arr = .Range("g2:J" & .Range("g" & Rows.Count).End(xlUp).Row)
  26.         brr = .Range("a2:b" & .Range("b" & Rows.Count).End(xlUp).Row)
  27.         
  28.         For b = 1 To UBound(arr)
  29.             New_Cer(arr(b, 1)) = arr(b, 2)
  30.             Ext_Cer(arr(b, 1)) = arr(b, 3)
  31.             Te_(arr(b, 1)) = arr(b, 4)
  32.         Next
  33.         
  34.         For m = 1 To UBound(brr)
  35.             IT(brr(m, 1)) = brr(m, 2)
  36.         Next
  37.         End With
  38.     '*************************************

  39.         Sheets("2019-2020 Project").Activate
  40.         'Set ws2 = ThisWorkbook.Worksheets("2019-2020 Project")
  41.         'With ws2
  42.         i = ActiveSheet.Range("C65536").End(xlUp).Row
  43.         k = 0
  44.     '**********************给需要填写的每个数组赋值***************************
  45.       
  46.         For j = 2 To i
  47.             If ActiveSheet.Range("C" & j).Value = Project_No Then
  48.                 Reg(k) = ActiveSheet.Range("G" & j).Value
  49.                 Veh_Type(k) = ActiveSheet.Range("H" & j).Value
  50.                 Disc(k) = ActiveSheet.Range("I" & j).Value
  51.                 New_or_Not(k) = New_Cer(Disc(k)).Item
  52.                 Exten_or_Not(k) = Ext_Cer(Disc(k)).Item
  53.                 Test_or_Not(k) = Te_(Disc(k)).Item
  54.                 Reg_tem(k) = Split(Reg(k), ".")(0)
  55.                 Item(k) = IT(Reg_tem(k)).Item
  56.                 k = k + 1
  57.             End If
  58.         Next
  59.         'End With
  60.     '***********************************************************************
  61.     '**************************创建表格,利用数组填充************************
  62.    
  63.     '***********************************************************************
  64.    
  65.     End If
  66. 'End If
  67. End Sub
复制代码


TA的精华主题

TA的得分主题

发表于 2020-3-7 13:12 | 显示全部楼层
Dim Reg(), Reg_tem(), Item(), Veh_Type(), Disc(), New_or_Not(), Exten_or_Not(), Test_or_Not()

这样声明的数组,在使用之前需要使用Redim什么数组的维度

  1.         For j = 2 To i
  2.             If ActiveSheet.Range("C" & j).Value = Project_No Then
  3.                 ReDim Preserve Reg(k)
  4.                 Reg(k) = ActiveSheet.Range("G" & j).Value
  5.                 k = k + 1
  6.             End If
  7.         Next
复制代码

评分

1

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-3-7 13:28 | 显示全部楼层
taller 发表于 2020-3-7 13:12
Dim Reg(), Reg_tem(), Item(), Veh_Type(), Disc(), New_or_Not(), Exten_or_Not(), Test_or_Not()

这 ...

感谢版主,我试下。

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-3-7 13:35 | 显示全部楼层
taller 发表于 2020-3-7 13:12
Dim Reg(), Reg_tem(), Item(), Veh_Type(), Disc(), New_or_Not(), Exten_or_Not(), Test_or_Not()

这 ...

我重新定义了下数组的维度,然后报错字典函数查找的数组没有定义object,字典函数查找后放入一个数组,是不是被放入的数组应该定义object属性呢?
  1.         For j = 2 To i
  2.             If ActiveSheet.Range("C" & j).Value = Project_No Then
  3.                 ReDim Preserve Reg(k), Reg_tem(k), Item(k), Veh_Type(k), Disc(k), New_or_Not(k), Exten_or_Not(k), Test_or_Not(k)
  4.                 Reg(k) = ActiveSheet.Range("G" & j).Value
  5.                 Veh_Type(k) = ActiveSheet.Range("H" & j).Value
  6.                 Disc(k) = ActiveSheet.Range("I" & j).Value
  7. <span style="background-color: sandybrown;">                New_or_Not(k) = New_Cer(Disc(k)).Item
  8.                 Exten_or_Not(k) = Ext_Cer(Disc(k)).Item
  9.                 Test_or_Not(k) = Te_(Disc(k)).Item</span>
  10.                 Reg_tem(k) = Split(Reg(k), ".")(0)
  11.                 Item(k) = IT(Reg_tem(k)).Item
  12.                 k = k + 1
  13.             End If
  14.         Next
复制代码


TA的精华主题

TA的得分主题

发表于 2020-3-7 13:48 | 显示全部楼层
然后报错字典函数查找的数组没有定义object - 不知道你说的错误是什么,请提供错误窗口截图,说明那一句代码出错

评分

1

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-3-7 13:53 | 显示全部楼层
taller 发表于 2020-3-7 13:48
然后报错字典函数查找的数组没有定义object - 不知道你说的错误是什么,请提供错误窗口截图,说明那一句代 ...

抱歉,是我外行了。麻烦看下报错窗口,出错行代码我标出来了。

11.png

TA的精华主题

TA的得分主题

发表于 2020-3-7 14:31 | 显示全部楼层

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-3-7 14:35 | 显示全部楼层

您太强大了,不愧大神。

可以请教下吗?.item是我查的dictionary的用法,不知道这个用在这里为什么会出错,不是对应关键字找到的值吗?

TA的精华主题

TA的得分主题

发表于 2020-3-8 03:36 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
Item是默认属性,可以简化

  1. Sub demo()
  2.     Set dic = CreateObject("Scripting.Dictionary")
  3.     For i = 1 To 10
  4.         dic(i) = i
  5.     Next
  6.     For i = 1 To 10
  7.         Debug.Print dic(i), dic.Item(i)
  8.     Next
  9. End Sub
复制代码

评分

1

查看全部评分

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

本版积分规则

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

GMT+8, 2024-3-28 21:33 , Processed in 0.051082 second(s), 11 queries , Gzip On, Redis On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

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

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

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