- 帖子
- 2834
- 主題
- 10
- 精華
- 0
- 積分
- 2890
- 點名
- 0
- 作業系統
- 〔略〕
- 軟體版本
- 〔略〕
- 閱讀權限
- 100
- 性別
- 男
- 來自
- 〔略〕
- 註冊時間
- 2013-5-13
- 最後登錄
- 2024-11-27
|
27#
發表於 2020-8-22 18:22
| 只看該作者
Sub TEST_V1()
Dim Arr, A, xD, i&, j%, N&, T$, V%
[成果!A2:D6000].ClearContents
Set xD = CreateObject("scripting.dictionary")
Arr = Range([目標!C1], [目標!A65536].End(xlUp))
For i = 2 To UBound(Arr)
T = Trim(Arr(i, 1)): If T <> "" Then xD(T) = 1
T = 拆解編號(Trim(Arr(i, 3))): If T = "" Then GoTo 101
For Each A In Split(T, "/"): xD(A & "") = 1: Next
101: Next i
Arr = Range([庫存!D1], [庫存!A65536].End(xlUp))
For i = 2 To UBound(Arr)
If xD("|" & i) > 0 Then GoTo 102 '如果該行已被提取過, 略過, 避免重覆提取
T = Trim(Arr(i, 1)): If Val(xD(T)) > 0 Then V = 1: GoTo 999 '[品號]相符即直接提取
T = Trim(Arr(i, 3)): If T = "" Then GoTo 102
T = 拆解編號(T) '拆解[規格]
For Each A In Split(T, "/")
If A <> "" And Val(xD(A & "")) > 0 Then V = 1: Exit For
Next
999:
If V = 0 Then GoTo 102
N = N + 1: V = 0
For j = 1 To 4: Arr(N, j) = Trim(Arr(i, j)): Next
xD("|" & i) = 1 '已提取行號位置,記錄入字典
102: Next i
If N > 0 Then [成果!A2:D2].Resize(N) = Arr
End Sub
'==========================================
Function 拆解編號(xS$) As String
Dim TT$, j%, ST$
If xS = "" Then Exit Function
If Left(xS, 4) Like "####" Then TT = Left(xS, 4)
If Left(xS, 5) Like "####[A-Z]" Then TT = Left(xS, 5) & "/" & TT
If Left(xS, 5) Like "[A-Z]####" Then TT = Left(xS, 5) & "/" & TT
If Left(xS, 8) Like "???-????" Then TT = Left(xS, 8) & "/" & TT
xS = xS & "-"
For j = Len(TT) + 2 To Len(xS)
If Mid(xS, j, 1) Like "[-.(]" Then TT = Left(xS, j - 1) & "/" & TT
Next j
拆解編號 = TT
End Function
模糊中又不能亂抓, 難~~~ |
|
發表於 2020-8-22 11:08
| 
