昨天一位老师建议我用字典查询，现在编出来了，但是运行还是存在点瑕疵，麻烦哪位....

wf888888

Sub test1()
Dim i, j As Long
Dim dic, dic1 As Object
Dim arr
Dim arr1
On Error Resume Next
Set dic = CreateObject("Scripting.Dictionary")
Set dic1 = CreateObject("Scripting.Dictionary")

arr = Sheet2.Range("A1").CurrentRegion
arr1 = Sheet2.Range("A1").CurrentRegion

For i = 2 To UBound(arr)
    dic.Add arr(i, 1), arr(i, 2)
Next i


For j = 2 To UBound(arr1)
    dic1.Add arr1(j, 1), arr1(j, 3)
Next j

arr = Sheet1.Range("A1").CurrentRegion
arr1 = Sheet1.Range("A1").CurrentRegion


For i = 2 To UBound(arr)
    arr(i, 2) = dic(arr(i, 1))
Next i


For j = 2 To UBound(arr1)
    arr1(j, 3) = dic1(arr1(j, 1))
Next j

Sheet1.Range("A1").CurrentRegion = arr
Sheet1.Range("A1").CurrentRegion = arr1

Set dic = Nothing
Set dic1 = Nothing

End Sub

程序
Sheet1.Range("A1").CurrentRegion = arr
Sheet1.Range("A1").CurrentRegion = arr1
上面两句以上部分运行均无问题，单独执行其中一句也无问题，合并运行存在问题，如何修改？

无关岁月

时间台账.7z (149.19 KB, 下载次数: 12)

2024-1-7 13:44 上传

点击文件名下载附件

wf888888

无关岁月 发表于 2024-1-7 13:44

谢谢老师，这种方式能解决两种表内容一样的问题，如果sheet1表的列顺序号与sheet2表不一样，或在最高温与最低温增加了几列别的内容，不能采用循环解决了，如是这种情况如何处理，谢谢

沈默00

列号不固定可以用find或match 抓取列号，

无关岁月

wf888888 发表于 2024-1-7 14:45
谢谢老师，这种方式能解决两种表内容一样的问题，如果sheet1表的列顺序号与sheet2表不一样，或在最高温与 ...

列号不固定，可以把列号做字典，文字题，就只能用文字回答了

wf888888

无关岁月 发表于 2024-1-7 15:25
列号不固定，可以把列号做字典，文字题，就只能用文字回答了

老师，我已上传文件，就是跨表跨列取值，采用字典的方法取值，不是采用match查找取值，谢谢！

ykcbf1100

标准的字典一查多，一个字典足够了。
楼主使用字典方法错误，要多多学习啊。

shinechou86

个人感觉数组就够用了，如果非要用字典一个也行。

wf888888

shinechou86 发表于 2024-1-7 20:37
个人感觉数组就够用了，如果非要用字典一个也行。

谢谢各位老师，本人感觉字典比数组快好多，故用字典，我的模块1就是用的数组，采用match计算的，结果正确，但速度较慢，一位老师建议我用字典，故第一次尝试，不知模块1的数组如何改进，速度更快，谢谢！

wf888888

shinechou86 发表于 2024-1-7 20:37
个人感觉数组就够用了，如果非要用字典一个也行。

谢谢，第一次用字典，学习中