{轉貼問題}將多個工作表依不同比對數據將對應的數值填入工作表1的欄位
- 帖子
- 2798
- 主題
- 10
- 精華
- 0
- 積分
- 2854
- 點名
- 0
- 作業系統
- 〔略〕
- 軟體版本
- 〔略〕
- 閱讀權限
- 100
- 性別
- 男
- 來自
- 〔略〕
- 註冊時間
- 2013-5-13
- 最後登錄
- 2024-4-15
|
Sub TEST_A1()
Dim Arr, Brr, Crr, Sn, T$, xD, R1&, R2&, Rx&, i&, j%, c%
Set xD = CreateObject("scripting.dictionary")
R1 = [工作表_1!A65536].End(xlUp).Row
R2 = [工作表_1!D65536].End(xlUp).Row
Rx = R1: If R2 > R1 Then Rx = R2
Arr = Sheets("工作表_1").Range("A1:D" & Rx)
For i = 1 To Rx
If Arr(i, 1) <> "" Then xD(Arr(i, 1) & "/A") = i
If Arr(i, 4) <> "" Then xD(Arr(i, 4) & "/D") = i
Next i
ReDim Crr(1 To Rx, 1 To 6)
For Each S In Split("工作表_3/工作表_4/工作表_7/工作表_2/工作表_5/工作表_6", "/")
R1 = Sheets(S & "").[a65536].End(xlUp).Row
Brr = Sheets(S & "").Range("A1:C" & R1)
c = c + 1
T = IIf(c > 3, "/D", "/A")
For i = 1 To R1
R2 = xD(Brr(i, 1) & T)
If R2 > 0 Then Crr(R2, c) = Brr(i, 3)
Next i
Next S
Sheets("工作表_1").[f1].Resize(Rx, 6) = Crr
End Sub
'=================================== |
|
|
|
|
|
|
|
發表於 2022-10-28 15:00
| 