请大师傅帮我改段代码

boomk

Sub 跨表查询返回()
'Application.ScreenUpdating = False
Dim dic As Object
Set dic = CreateObject("Scripting.Dictionary")
Dim i As Long, j As Long, arr         
For i = 3 To Sheets.Count
arr = Sheets(i).Range("A1").CurrentRegion
For j = 2 To UBound(arr)
dic.Add arr(j, 1), arr(j, 3)
Next
Next
arr = Sheets("PDF").Range("a1").CurrentRegion
For i = 2 To UBound(arr)
arr(i, 2) = dic(arr(i, 1))
Next '循环
Sheets("PDF").Range("a1").CurrentRegion = arr
Range("B2", Range("B2").End(xlDown)).Offset(0, 1).Select
End Sub
我是初学VB,这段只是字典返回1个字段,我想返回多个字段,不知道该怎么修改

boomk

代码是要能在个人宏里起作用的.

Yalishanda30

boomk 发表于 2023-4-15 17:37
代码是要能在个人宏里起作用的.

不知道你要干什么

boomk

Yalishanda30 发表于 2023-4-15 20:05
不知道你要干什么

你不看你当然不知道了
就匹配返回结果.
工作簿中三个表,名为sheet1/PDF/阿里.
sheet1是模板,格式不能该变的.里面的数据是由PDF表复制进去的,这里就跳过不用看了.
PDF表是外部数据导入修改后的格式,原本三个字段,实际只要2个字段就行了
阿里表,算是数据库吧,三个字段,
"PDF"和"阿里"第一个字段为Key,匹配数据库的第三字段.
原本工作簿中有其他表,行数也挺多,就给删了,不影响说明和代码使用.
发在一楼的代码是能用的.
但是只是匹配一个字段.
我想一个KEY匹配多个字段,又不知道怎么改,
比如我在PDF表和阿里表中都加入"单位"字段或者再加其他字段,怎么一次通过KEY匹配写入.
总之,是如何使用字典进行跨表多字段匹配.
如果,还是不能理解......
那肯定是我的浅显理解不能让我表述到位
......实在不行就要录屏说明求解了.

3190496160

Sub 跨表查询返回()
Application.ScreenUpdating = False
Dim dic As Object
Set dic = CreateObject("Scripting.Dictionary")
Dim i As Long, j As Long, arr
For i = 3 To Sheets.Count
    brr = Sheets(i).Range("A1").CurrentRegion
    For j = 2 To UBound(brr)
        If Trim(brr(j, 1)) <> "" Then
            dic(brr(j, 1)) = j
        End If
    Next
Next
With Sheets("PDF")
    arr = .Range("a1").CurrentRegion
    For i = 2 To UBound(arr)
        If Trim(arr(i, 1)) <> "" Then
            xh = dic(Trim(arr(i, 1)))
            If xh <> "" Then
                arr(i, 2) = brr(xh, 2)
                arr(i, 3) = brr(xh, 4)
            End If
        End If
    Next '循环
    .Range("a1").CurrentRegion = arr
    .Range("B2", Range("B2").End(xlDown)).Offset(0, 1).Select
End With
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub

3190496160

求助贴.rar (23.41 KB, 下载次数: 6)

2023-4-16 12:31 上传

点击文件名下载附件

boomk

OK是真的OK,谢谢大师傅.

boomk

3190496160 发表于 2023-4-16 12:31

OK是真的OK,谢谢大师傅.
另外借楼,再请教一下,如下两段代码:
Sub 自动添加序列号()
    Dim i As Integer
    On Error GoTo Last
    i = InputBox("请输入需要的值", "输入序列号 ")

                                               
    For i = 1 To i
        ActiveCell.Value = i
        ActiveCell.Offset(1, 0).Activate
    Next i
Last:    Exit Sub
End Sub
Sub 自动根据最下非空行添加序列号()
    Dim i%, y%, k%
    On Error GoTo Last

    y = 1

    k = Cells(Rows.Count, 2).End(xlUp).Row - 2

    For i = 1 To k

        Sheet1.Cells(i + 2, 1) = y
        y = y + 1
    Next i
Last:    Exit Sub
End Sub
首先说明:这两段都是能用的.
可是,放在个人宏中,第一段能用,第二段就不能用了.
那么第二段怎么修改,才能让它在个人宏中也能起作用.
(因为是导入模板表不能存在函数和宏,所以不能保存为宏表,我一般都搞在个人宏里,像功能按钮一样用的.)请大师傅抽空再给摸摸

boomk

3190496160 发表于 2023-4-16 12:31

我那工作簿中15张表,最大行800多,最小行20多,运行代码时提示"下标越界"....图片地址不知道怎么弄的,不会传图片.

boomk

3190496160 发表于 2023-4-16 12:31

下标越界,该怎么修正