|
各位大神,我想做一个通过关键词查找对应字段的程序,但是不知道是不是数组定义有问题,运行时不是提示数据类型不匹配,就是提醒“ subscript out of range”。代码放上,想找下问题出在哪儿。
- Private Sub Worksheet_Change(ByVal Target As Range)
- If Target.Address <> "$L$2" Then Exit Sub
- check = MsgBox("Do you want to create E4 APPLICATION FILE, Continue? Yes/Not", vbYesNo)
- If check = vbYes Then
- '***********定义************
- Dim Project_No As String
- Dim Reg(), Reg_tem(), Item(), Veh_Type(), Disc(), New_or_Not(), Exten_or_Not(), Test_or_Not() 'As Object
- Dim arr(), brr()
- Dim ws1 As Worksheet
-
- Dim i, j, k, b, m As Integer ' n
-
- '******************************
- Project_No = Range("L2").Value '给project No赋值
-
- '**********定义字典********************
- Sheets("Sheet2").Activate
- Set ws1 = ThisWorkbook.Worksheets("sheet2")
- With ws1
- Dim New_Cer, Ext_Cer, Te_, IT As Object
- Set New_Cer = CreateObject("Scripting.Dictionary")
- Set Ext_Cer = CreateObject("Scripting.Dictionary")
- Set Te_ = CreateObject("Scripting.Dictionary")
- Set IT = CreateObject("Scripting.Dictionary")
- arr = .Range("g2:J" & .Range("g" & Rows.Count).End(xlUp).Row)
- brr = .Range("a2:b" & .Range("b" & Rows.Count).End(xlUp).Row)
-
- For b = 1 To UBound(arr)
- New_Cer(arr(b, 1)) = arr(b, 2)
- Ext_Cer(arr(b, 1)) = arr(b, 3)
- Te_(arr(b, 1)) = arr(b, 4)
- Next
-
- For m = 1 To UBound(brr)
- IT(brr(m, 1)) = brr(m, 2)
- Next
- End With
- '*************************************
- Sheets("2019-2020 Project").Activate
- 'Set ws2 = ThisWorkbook.Worksheets("2019-2020 Project")
- 'With ws2
- i = ActiveSheet.Range("C65536").End(xlUp).Row
- k = 0
- '**********************给需要填写的每个数组赋值***************************
-
- For j = 2 To i
- If ActiveSheet.Range("C" & j).Value = Project_No Then
- Reg(k) = ActiveSheet.Range("G" & j).Value
- Veh_Type(k) = ActiveSheet.Range("H" & j).Value
- Disc(k) = ActiveSheet.Range("I" & j).Value
- New_or_Not(k) = New_Cer(Disc(k)).Item
- Exten_or_Not(k) = Ext_Cer(Disc(k)).Item
- Test_or_Not(k) = Te_(Disc(k)).Item
- Reg_tem(k) = Split(Reg(k), ".")(0)
- Item(k) = IT(Reg_tem(k)).Item
- k = k + 1
- End If
- Next
- 'End With
- '***********************************************************************
- '**************************创建表格,利用数组填充************************
-
- '***********************************************************************
-
- End If
- 'End If
- End Sub
复制代码
|
|