求数据

晶晶乐

根据相关数据，得出有数据的数据

半百

G:I列是已知的还是要代码连同J列一起生成？

晶晶乐

g:i是已知的，求j

半百

Sub test()
Set d = CreateObject("Scripting.Dictionary")
With ActiveSheet
    r = .Cells(Rows.Count, 1).End(3).Row
    arr = .Range("a2:d" & r)
    For i = 1 To r - 1
        If arr(i, 4) <> "" Then d(arr(i, 1) & "|" & arr(i, 2) & "|" & arr(i, 3)) = arr(i, 4)
    Next
    r = .Cells(Rows.Count, 7).End(3).Row
    arr = .Range("g2:j" & r)
    For i = 1 To r - 1
        arr(i, 4) = d(arr(i, 1) & "|" & arr(i, 2) & "|" & arr(i, 3))
    Next
    .Range("g2:j" & r) = arr
End With
End Sub

fzxba

1. Sub test0()
   
2.   
   
3.   Dim Conn As Object
   
4.   Dim strConn As String, SQL As String
   
5.   
   
6.   Set Conn = CreateObject("ADODB.Connection")
   
7.   
   
8.   If Application.Version < 12 Then
   
9.     strConn = "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;HDR=NO;IMEX=1';Data Source="
   
10.   Else
    
11.     strConn = "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties='Excel 12.0;HDR=NO;IMEX=1';Data Source="
    
12.   End If
    
13.   Conn.Open strConn & ThisWorkbook.FullName
    
14.   
    
15.   SQL = "SELECT F1,F2,F3,MAX(F4) AS F4 FROM (SELECT F1,F2,F3,F4 FROM [$A2:D] WHERE F4 IS NOT NULL) GROUP BY F1,F2,F3"
    
16.   SQL = "SELECT a.*,b.F4 FROM [$G2:I] a LEFT JOIN (" & SQL & ") b ON a.F1=b.F1 AND a.F2=b.F2 AND a.F3=b.F3"
    
17.   Range("G2").CopyFromRecordset Conn.Execute(SQL)
    
18.   
    
19.   Conn.Close
    
20.   Set Conn = Nothing
    
21.   Beep
    
22. End Sub

复制代码

ykcbf1100

附件供参考。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()   '//2024.3.19
   
2.     Dim arr, d
   
3.     Application.ScreenUpdating = False
   
4.     Set d = CreateObject("Scripting.Dictionary")
   
5.     With Sheets("Sheet2")
   
6.         r = .Cells(.Rows.Count, "a").End(xlUp).Row
   
7.         arr = .[a1].Resize(r, 4)
   
8.         For i = 2 To UBound(arr)
   
9.             s = arr(i, 1) & "|" & arr(i, 2) & "|" & arr(i, 3)
   
10.             d(s) = arr(i, 4)
    
11.         Next
    
12.         r = .Cells(.Rows.Count, "g").End(xlUp).Row
    
13.         arr = .[g1].Resize(r, 4)
    
14.         For i = 2 To UBound(arr)
    
15.             s = arr(i, 1) & "|" & arr(i, 2) & "|" & arr(i, 3)
    
16.             If d.Exists(s) Then
    
17.                 arr(i, 4) = d(s)
    
18.             Else
    
19.                 arr(i, 4) = ""
    
20.             End If
    
21.         Next
    
22.         .[g1].Resize(r, 4) = arr
    
23.     End With
    
24.     Set d = Nothing
    
25.     Application.ScreenUpdating = True
    
26.     MsgBox "OK！"
    
27. End Sub

复制代码

晶晶乐

忘了说了，我是二个表