- 帖子
- 1446
- 主題
- 40
- 精華
- 0
- 積分
- 1470
- 點名
- 0
- 作業系統
- Windows 7
- 軟體版本
- Excel 2010 & 2016
- 閱讀權限
- 50
- 性別
- 男
- 來自
- 台灣
- 註冊時間
- 2020-7-15
- 最後登錄
- 2024-10-21
|
6#
發表於 2023-11-24 11:15
| 只看該作者
本帖最後由 Andy2483 於 2023-11-24 18:31 編輯
回復 2# 爆肝達人
謝謝前輩發表此主題與範例
後學藉此帖學習到很多知識,學習方案如下,請前輩參考
執行結果:
Option Explicit
Sub TEST()
Dim Brr, Z, i&, j%, c%, K, T$, T1$, T2$, T3$
Dim xR As Range, Ra As Range, Sh As Worksheet, xBook As Workbook
Set Z = CreateObject("Scripting.Dictionary")
Brr = Range([mapping!B2], [mapping!A65536].End(3))
For i = 1 To UBound(Brr): Z(Brr(i, 1)) = Brr(i, 2): Next
Brr = Range([source!B3], [source!A65536].End(3))
For i = 1 To UBound(Brr)
T = Trim(Replace(Replace(Replace(Replace(Brr(i, 1), Chr(10), ""), Chr(9), ""), Chr(7), ""), Chr(13), ""))
If T = "" Or (InStr(T, "_") + InStr(T, "-")) = 0 Then Brr(i, 1) = "": GoTo i01
If InStr(T & "_", "_") > InStr(T & "-", "-") Then
T = Left(T, InStr(T, "-") - 1) & "_" & Mid(T, InStr(T, "-") + 1)
End If
T1 = Left(T, InStr(T, "_"))
T2 = Mid(T, InStr(T, "_") + 1)
For Each K In Z.Keys: T3 = IIf(InStr(T, K), T3 & "/" & Z(K), T3): Next
Brr(i, 1) = T1 & T2 & ";" & Val(Brr(i, 2)) & ":" & Mid(T3, 2)
T3 = ""
i01: Next
[C3].Resize(UBound(Brr)) = Brr
End Sub |
|
發表於 2023-11-25 11:19
| 