- 帖子
- 254
- 主題
- 6
- 精華
- 0
- 積分
- 310
- 點名
- 0
- 作業系統
- W10
- 軟體版本
- Excel 2016
- 閱讀權限
- 20
- 性別
- 男
- 來自
- 台灣
- 註冊時間
- 2019-6-16
- 最後登錄
- 2024-9-23
|
63#
發表於 2020-9-12 17:31
| 只看該作者
本帖最後由 軒云熊 於 2020-9-12 17:39 編輯
回復 62# 准提部林
謝謝準大的指導 但這方式 只是在字典裡刪除重複而已 不過應該會比較快一點點 字典判斷重複陣列不提取的方式還在努力...- Public Sub 陣列加Function加字典練習()
- Application.ScreenUpdating = False
- If [成果!A1] <> "" Then [成果!A1].CurrentRegion.Clear
- Crr = [目標!A1].CurrentRegion
- Brr = [庫存!A1].CurrentRegion
- ReDim Drr(1 To UBound(Brr, 1), 1 To UBound(Brr, 2))
- Set xD = CreateObject("Scripting.Dictionary")
- For i = 1 To UBound(Crr)
- A3 = 分割文字(Trim(Crr(i, 3)))
- A1 = Trim(Crr(i, 1))
- For N = 1 To UBound(Brr)
- B3 = 分割文字(Trim(Brr(N, 3)))
- B1 = Trim(Brr(N, 1))
- If A1 Like B1 Or A3 Like B3 And A3 <> "" Then
- xD(Brr(N, 1)) = Brr(N, 1)
- End If
- Next N
- Next i
- For E = 1 To UBound(Brr)
- If Brr(E, 1) = xD(Brr(E, 1)) Then
- G = G + 1
- For F = 1 To UBound(Brr, 2)
- Drr(G, F) = Brr(E, F)
- Next F
- End If
- Next E
- Erase Brr, Crr
- [成果!A1].Resize(G, UBound(Drr, 2)) = ""
- [成果!A1].Resize(G, UBound(Drr, 2)) = Drr
- Erase Drr
- Sheets(3).Activate
- Cells(1, 1).Select
- Application.ScreenUpdating = False
- End Sub
- '====================================================================
- Public Function 分割文字(A3)
- Drx = Array("-", ".")
- A7 = "": A8 = ""
- For A9 = LBound(Drx) To UBound(Drx)
- For A0 = 1 To Len(A3)
- If InStr(Mid(Right(A3, A0), 1, 1), Drx(A9)) Then
- A8 = Mid(Right(A3, A0), 1, A0)
- A7 = Mid(A3, 1, Len(A3) - Len(A8))
- Exit For
- End If
- Next A0
- Next A9
- If A7 = "" Then A7 = A3
- If A7 = "" Then Exit Function
- If Left(A7, 4) Like "####" Then
- X = Mid(A7, 1, 4)
- ElseIf Left(A7, 5) Like "####[A-Z]" Then
- X = Mid(A7, 1, 5)
- ElseIf Left(A7, 5) Like "[A-Z]####" Then
- X = Mid(A7, 1, 5)
- ElseIf Left(A7, 8) Like "???-????" Then
- X = Mid(A7, 1, 8)
- End If
- If X = "" Then X = A3
- 分割文字 = X
- End Function
|
|
發表於 2020-9-11 12:44
| 
