您好，请指教下，如何根据关键词用VBA查询

excelhome9819

您好，请指教下，如何根据关键词用VBA查询
在原始数据表中，以I列的终点编码为关键词，根据该关键词查找，而J列的数据为空的时候，就在该表中匹配出J列线路的值
比如在I列，有终点编码
-1-XL1，1AP，-1-XL2，-1-ZM1，DT，JYFJ，SB1，SB2，2AP，ZMr，其J列的线路值为空

比如终点编码1AP，在G列配电箱前进线中，1AP的线路为Z-YJV-(4x240+1x120)SC100/CT，而同时在G列竖向系统图纸，起点编码为#4箱变，1AP的线路为空，就希望能用VBA自动匹配出线路值        Z-YJV-(4x240+1x120)SC100/CT
原始数据表：

希望查询匹配结果

谢谢指导。原始数据文件和希望结果文件请见附件。

看见星光

这不就一个简单的字典查询的问题吗？

1. Sub dcheck()
   
2.     Dim d As Object
   
3.     Dim arr, i&, s$
   
4.     Set d = CreateObject("scripting.dictionary")
   
5.     arr = Range("g1:j" & Cells(Rows.Count, "g").End(xlUp).Row)
   
6.     For i = 1 To UBound(arr)
   
7.         If arr(i, 4) <> "" Then
   
8.             If Not d.exists(arr(i, 3)) Then d(arr(i, 3)) = arr(i, 4)
   
9.         End If
   
10.     Next
    
11.     For i = 1 To UBound(arr)
    
12.         If arr(i, 4) = "" Then
    
13.             If d.exists(arr(i, 3)) Then arr(i, 4) = d(arr(i, 3))
    
14.         End If
    
15.     Next
    
16.     Range("g1:j" & Cells(Rows.Count, "g").End(xlUp).Row) = arr
    
17.     Set d = Nothing
    
18. End Sub
    

复制代码

一把小刀闯天下

'108行规则有问题？

Option Explicit

Sub test()
  Dim arr, i, j
  arr = Range("g2:j" & [g2].End(xlDown).Row)
  For i = 1 To UBound(arr, 1)
    If Len(arr(i, 2)) = 0 And Len(arr(i, 3)) > 0 And Len(arr(i, 4)) > 0 Then
      For j = 1 To UBound(arr, 1)
        If Len(arr(j, 2)) > 0 And arr(j, 3) = arr(i, 3) And Len(arr(j, 4)) = 0 Then arr(j, 4) = arr(i, 4)
      Next
    End If
  Next
  [a2].Resize(UBound(arr, 1), UBound(arr, 2)) = arr
End Sub

excelhome9819

看见星光 发表于 2019-10-20 15:32
这不就一个简单的字典查询的问题吗？

前几天有事情，来晚了。很棒，谢谢！

excelhome9819

一把小刀闯天下 发表于 2019-10-20 15:42
'108行规则有问题？

Option Explicit

前几天有事情，来晚了。很棒，谢谢！