198188

回復 30# Andy2483


    前輩指哪個資料？ KP & KH 還是執行的工作表？
三個表裏的文字都是數字，沒有符號。

Andy2483

回復 31# 198188


    今天才查到2列與137列關鍵字相同,後學不察,抱歉

准提部林

回復 25# 198188


是問:除了噴油, 還有沒有其它? 例如:上膜??
即同一鍵值, 有不同工作內容???

BF/BH  噴油/上膜~~~

198188

回復 33# 准提部林


Project 名稱 （BH / BF) 這些會經常變動，
KH / KP 欄裏只有噴油，沒有其他了

198188

回復 32# Andy2483


    執行工作表裏面的資料 (SECTION & LENGTH) 組合會有重複性的，因爲是包裝不同的NO裏，所以(SECTION & LENGTH) 組合不會是唯一

Andy2483

回復 35# 198188
謝謝前輩指導,請再試試看
Option Explicit
Sub TEST()
Dim Arr, Brr, Crr, V$, Z, Q, i&, T$, TT$, A, xA As Range, N%, C%
Set Z = CreateObject("Scripting.Dictionary")
Set xA = Range(ActiveSheet.[G1], ActiveSheet.[B65536].End(3)(1, 0))
xA.Offset(1, 12).Resize(, 3).ClearContents:  Brr = xA
For i = 2 To UBound(Brr)
   T = Format(Trim(Brr(i, 2)), "0000000"): V = Format(Val(Brr(i, 7)), "0000000"): TT = T & "/" & V
   Z(TT) = Z(TT) & "/" & i
Next
Arr = ActiveSheet.[M1].Resize(UBound(Brr), 3)
A = Array(Range([KH!C1], [KH!A65536].End(3)), Range([KH!J1], [KH!H65536].End(3)), Range([KP!C1], [KP!A65536].End(3)), Range([KP!J1], [KP!H65536].End(3)))
For Each Crr In A
   Crr = Crr: N = N + 1
   For i = 3 To UBound(Crr)
      T = Format(Trim(Crr(i, 1)), "0000000"): V = Format(Val(Crr(i, 2)), "0000000"): TT = T & "/" & V
      If Z.Exists(TT) Then
         Q = Split(Z(TT) & "/", "/")
         For C = 1 To UBound(Q) - 1
            If Arr(Q(C), 1) = "" Then
               Arr(Q(C), 1) = Crr(1, 1)
               ElseIf InStr("/" & Arr(Q(C), 1) & "/", "/" & Crr(1, 1) & "/") = 0 Then
               Arr(Q(C), 1) = Arr(Q(C), 1) & "/" & Crr(1, 1)
            End If
            Arr(Q(C), N \ 3 + 2) = Crr(1, 3)
         Next
      End If
   Next
Next
ActiveSheet.[M1].Resize(UBound(Brr), 3) = Arr
End Sub

198188

下載 (17.25 KB)

2024-3-5 17:49

回復 36# Andy2483


    測試過，答案沒有問題。
另外有個問題，請問 "噴油" 是讀取 KP & KH  工作表内 C1 & J1 的儲存格嗎？ 我測試過好像不是，請問程式哪個位置是操作這個的？
因爲有兩種選擇 “ 噴油” 和 “不噴油”，我想看看能不能自己修改一下。
或者能否像帖子裏的圖片，第一欄模號，第二欄長度，第三欄 “噴油” 或者 空白，然後直接讀取第三欄的數據。

Andy2483

回復 37# 198188

Crr(1, 3)  改為 Crr(i, 3). 試試看