楼主
liuguansky |
Q：如何依条件跨工作簿对多列值加以判断返回？
A：用如下代码可以实现，速度在0.1S内[数组+字典]
- Sub justtest()
- Dim dic, arr, i&, arr1, arr2() As String, arr3(), t '定义相关变量
- Set dic = CreateObject("scripting.dictionary") '调用字典对象
- Application.ScreenUpdating = False '禁止屏幕刷新
- t = Timer '设置初始时间
- Workbooks.Open (ThisWorkbook.Path & "\印刷工程單記錄表.xls") '打开工作簿
- With ActiveWorkbook
- With .Sheets("工程單明細")
- arr = .Range("a3:v" & .Cells(.Rows.Count, 1).End(3).Row).Value '把查找源数据信息赋值给数组
- End With
- For i = 1 To UBound(arr, 1)
- dic(arr(i, 1)) = i '循环赋值，用于确认行号
- Next i
- .Close '关闭工作簿
- End With
- arr1 = Range("b5:b" & Cells(Rows.Count, 2).End(3).Row).Value '把要查找的数据赋值给数组
- ReDim arr2(1 To UBound(arr1, 1), 1 To 1) '货号返回数组定义
- ReDim arr3(1 To UBound(arr1, 1), 1 To 4) '尺寸面积返回数组定义
- For i = 1 To UBound(arr1, 1)
- If dic.exists(arr1(i, 1)) Then '如果查找到记录的话
- k = dic(arr1(i, 1)) '确认行号
- arr2(i, 1) = arr(k, 3) '进行行号值返回
- arr3(i, 1) = arr(k, 21) '进行行号值返回
- arr3(i, 3) = arr(k, 22) '进行行号值返回
- If arr3(i, 1) <> "" And arr3(i, 3) <> "" Then '判断I K是否为空
- arr3(i, 2) = "X": arr3(i, 4) = Round(CSng(arr3(i, 1)) * CSng(arr3(i, 3)), 2) '均不为空的时候，进行X和乘积处理
- Else: arr3(i, 2) = "": arr3(i, 4) = "" '否则返回空
- End If
- Else: arr3(i, 1) = "": arr3(i, 2) = "": arr3(i, 3) = "": arr3(i, 4) = "" '没有找到记录返回空
- End If
- Next i
- Range("c5:c" & Rows.Count).ClearContents '清空返回数据区域
- Range("i5:l" & Rows.Count).ClearContents '清空返回数据区域
- Cells(5, 3).Resize(UBound(arr2, 1), 1) = arr2 '把生成结果数组返回给区域
- Cells(5, "i").Resize(UBound(arr3, 1), 4) = arr3 '把生成结果数组返回给区域
- MsgBox "查找完成，共用时：" & vbCrLf & Timer - t '友好提示处理完毕，并对时间进行返回
- Application.ScreenUpdating = True '启用屏幕刷新
- Set dic = Nothing '释放字典内存
- End Sub
具体示例文件如下：
|