求助一个代码问题-Excel VBA程序开发-ExcelHome技术论坛

2025-11-10 12:02 关注

本帖最后由 ryoryo66 于 2025-11-10 12:12 编辑

如果表“1”里A列里的值不为空，并且等于表“2”里A列的值时，
那么就把表“1”里A列对应的D9：D383区域内的值赋给表“2”里对应的ac变量列。

这个用普通遍历比较简单，但是速度有点慢，有没有快速的办法啊。帮忙写一个啊

求助.rar 2025-11-10 12:01 上传

84.07 KB, 下载次数: 35

赏

491阅读

shiruiqiang Lv.6 2楼

2025-11-10 12:04

字典+数组，基本不卡

sancoz Lv.2 3楼

2025-11-10 12:05

你这样表没代码啊

ryoryo66 楼主 4楼

2025-11-10 12:12

引用: shiruiqiang 发表于 2025-11-10 12:04
字典+数组，基本不卡

能不能帮忙写一个啊

ynzsvt Lv.4 5楼

2025-11-10 14:14

……………

求助.rar 2025-11-10 14:14 上传

92.79 KB, 下载次数: 4

ynzsvt Lv.4 6楼

2025-11-10 14:16

laoye5403 Lv.2 7楼

2025-11-10 14:22

字典+数组

Sub 查找()
Set d = CreateObject("Scripting.Dictionary")
ar = Sheets("1").UsedRange.Value
r = Sheets("2").Cells(Rows.Count, 1).End(3).Row
br = Range("a2:a" & r)
ReDim cr(1 To UBound(br), 1 To 1)
For i = 9 To UBound(ar)
If ar(i, 1) <> "" Then d(ar(i, 1)) = ar(i, 4)
Next i
For i = 2 To UBound(br)
cr(i, 1) = d(br(i, 1))
Next i
Sheets("2").[ac2].Resize(UBound(cr), 1).Value = cr
End Sub

求助1110.rar 2025-11-10 14:22 上传

93.16 KB, 下载次数: 2

榆榆木 Lv.2 8楼

2025-11-10 14:52

简单的字典查询，点击按钮就可以了

求助.rar 2025-11-10 14:50 上传

91.86 KB, 下载次数: 4

榆榆木 Lv.2 9楼

2025-11-10 15:33

Option Explicit

Sub test()
Dim i As Long
Dim d As Object
Dim ar, br, r As Long
Dim dw As String, kw As String
Set d = CreateObject("Scripting.Dictionary")
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

With Sheets("1")
      r = .Range("a" & Rows.Count).End(xlUp).Row
      ar = .Range("a1:d" & r).Value
End With
For i = 1 To UBound(ar)
      kw = ar(i, 1)
      If kw <> "" Then d(kw) = ar(i, 4)
Next

With Sheets("2")
      r = .Range("a" & Rows.Count).End(xlUp).Row
      br = Range("a1:a" & r).Value

      For i = 1 To UBound(br)
         dw = br(i, 1)
         If d.Exists(dw) And dw <> "" Then
            .Range("ac" & i) = d(dw)
         End If
      Next
End With
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

榆榆木 Lv.2 10楼

2025-11-10 15:45

Option Explicit

Sub test()
Dim i As Long
Dim d As Object
Dim ar, br, r As Long
Dim dw As String, kw As String
Set d = CreateObject("Scripting.Dictionary")
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

With Sheets("1")
      r = .Range("a" & Rows.Count).End(xlUp).Row
      ar = .Range("a1:d" & r).Value
End With
For i = 1 To UBound(ar)
      kw = ar(i, 1)
      If kw <> "" Then d(kw) = ar(i, 4)
Next

With Sheets("2")
      r = .Range("a" & Rows.Count).End(xlUp).Row
      br = Range("a1:a" & r).Value

      For i = 1 To UBound(br)
         dw = br(i, 1)
         If d.Exists(dw) And dw <> "" Then
            .Range("ac" & i) = d(dw)
         End If
      Next
End With
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub