儲存格內遇頓號如何比對後帶出資料及作樞紐分析

leiru

問題1：
請問儲存格內遇到頓號，如何比對出科目
C欄代號比對G欄，在D欄帶出H欄科目，但遇到C欄有頓號無法帶出，正確答案為E欄

問題2：
另外，如果D欄求出如E欄資料，如何利用A欄至D欄作樞紐分析，版面配置如下：

leiru

不好意思，問題２樞紐分析部份不用解題，因為金額部份未拆出來

准提部林

１）代號在一格內最多２個？
２）代號固定３個字元？
３）代號中〔頓號〕後面有一個不可見字元，是正確的？　每筆都是？

Ｄ２：先試這個
=IFERROR(VLOOKUP(LEFT(C2,3),G:H,2,),"")&IFERROR("、"&VLOOKUP(MID(C2,6,3),G:H,2,),"")

leiru

回復 3# 准提部林


    謝謝回覆

１）代號在一格內最多２個？                                                                                      ANS：沒有限制幾個
２）代號固定３個字元？                                                                                              ANS：固定３個字元
３）代號中〔頓號〕後面有一個不可見字元，是正確的？　每筆都是？              ANS：請問您怎麼會想到判斷有不可見字元。。。我用ALT+160去尋找確實有

准提部林

回復 4# leiru

代號個數不固定, 沒有最新版的文字連接函數, 估計要用VBA!
G/H欄範例資料太少, 可能有判斷不到的地方,
那不可見字元, 似有還無, 是個頭疼問題~~

等些天, 若沒有人提出公式解, 再轉到程式區吧~~

leiru

回復 5# 准提部林


    謝謝
B欄,C欄,D欄都有2個字串,請問遇到B欄金額,C欄代號,D欄科目轉換成逐列顯示，例如：B4:D4轉換成B31:D32

准提部林

回復 6# leiru


Sub 重整()
Dim Arr, Brr, A, B, xD, i&, j%, N&, T$
[I2:L6000].Clear
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range([G2], [F65536].End(xlUp))
For i = 1 To UBound(Arr)
    xD(Arr(i, 1) & "") = Arr(i, 2)
Next i
Arr = Range([C2], [A65536].End(xlUp))
ReDim Brr(1 To 20000, 1 To 4)
For i = 1 To UBound(Arr)
    A = Split(Replace(Arr(i, 2), ChrW(160), ""), "、")
    B = Split(Replace(Arr(i, 3), ChrW(160), ""), "、")
    If UBound(A) <> UBound(B) Then MsgBox "第 " & i + 1 & " 行數據有問題!! ": Exit Sub
    For j = 0 To UBound(A)
        N = N + 1:  T = T & "、" & xD(B(j) & "")
        Brr(N, 1) = Arr(i, 1):   Brr(N, 2) = A(j)
        Brr(N, 3) = B(j):   Brr(N, 4) = xD(B(j) & "")
    Next j
    Arr(i, 1) = Mid(T, 2): T = ""
Next i
With [I2].Resize(N, 4)
     .Columns(2).NumberFormatLocal = "#,##0 ;-#,##0 "
     .Columns(3).HorizontalAlignment = xlCenter
     .Columns(4).NumberFormatLocal = "@"
     .Borders.LineStyle = 1:  .Font.Size = 10
     .Value = Brr
End With
[D2].Resize(UBound(Arr)) = Arr '填入D欄對應值
End Sub


Xl0000397.rar (30.75 KB)

下載次數: 2

2018-12-1 10:27

Andy2483

回復 7# 准提部林


    謝謝論壇,謝謝前輩指導
後學藉此帖學習前輩的方案,執行結果與心得註解如下,請前輩再指導

執行前:

下載 (156.38 KB)

2023-11-9 09:14

執行結果:

下載 (257.17 KB)

2023-11-9 09:14

Sub 重整()
Dim Arr, Brr, A, B, xD, i&, N&, j%, T$
'↑宣告變數:(Arr,Brr,A,B,xD)是通用型變數,(i,N)是長整數,j是短整數,T是字串變數
[I2:L6000].Clear
'↑令[I2:L6000]這範圍儲存格清除
Set xD = CreateObject("Scripting.Dictionary")
'↑令xD這通用型變數是 字典
Arr = Range([G2], [F65536].End(xlUp))
'↑令Arr這通用型變數是二維陣列,以[G2]到F欄最後有內容儲存格值帶入陣列中
For i = 1 To UBound(Arr)
'↑設順迴圈!令i從1 到Arr陣列縱向最大索引列號
    xD(Arr(i, 1) & "") = Arr(i, 2)
    '↑令i迴圈列1欄Arr陣列值(字串)當key,
    'item是 i迴圈列1欄Arr陣列值,納入xD字典中
Next i

Arr = Range([C2], [A65536].End(xlUp))
'↑令Arr陣列換裝盛 [C2]到A欄最後有內容儲存格 值
ReDim Brr(1 To 20000, 1 To 4)
'↑宣告Brr空陣列的範圍,縱向索引號1~20000,橫向1~4
For i = 1 To UBound(Arr)
'↑設順迴圈!令i從1 到Arr陣列縱向最大索引列號
    A = Split(Replace(Arr(i, 2), ChrW(160), ""), "、")
   '↑令A這通用型變數是 一維陣列:
    'i迴圈列2欄Arr陣列值經至換字元(空格>>空字元)成的新字串,再以"、"分割成的陣列
    https://learn.microsoft.com/zh-t ... haracter-set-128255
    B = Split(Replace(Arr(i, 3), ChrW(160), ""), "、")
    '↑令B這通用型變數是 一維陣列:
    'i迴圈列3欄Arr陣列值經至換字元(空格>>空字元)成的新字串,再以"、"分割成的陣列
    If UBound(A) <> UBound(B) Then MsgBox "第 " & i + 1 & " 行數據有問題!! ": Exit Sub
    '↑如果A陣列最大索引號與 如果B陣列最大索引號不同?
    'true就跳出提示窗~~~:結束程式執行
    For j = 0 To UBound(A)
    '↑設順迴圈!令j從1 到A陣列最大索引號
        N = N + 1:  T = T & "、" & xD(B(j) & "")
        '↑令N這長整數變數累加1
        '↑令T這字串變數是 自身連接 "、" 再連接(以j迴圈B陣列值字串查xD字典回傳值)
        Brr(N, 1) = Arr(i, 1):   Brr(N, 2) = A(j)
        '↑令N變數列1欄Brr陣列值是 i迴圈列1欄Arr陣列值
        '↑令N變數列2欄Brr陣列值是 j迴圈A陣列值
        Brr(N, 3) = B(j):   Brr(N, 4) = xD(B(j) & "")
        '↑令N變數列3欄Brr陣列值是 j迴圈B陣列值
        '↑令N變數列4欄Brr陣列值是 以j迴圈B陣列值字串查xD字典回傳值
    Next j
    Arr(i, 1) = Mid(T, 2): T = ""
    '↑令i迴圈列1欄Arr陣列值是 T變數去除第1個字元的新字串
    '令T變數字串清空
Next i

With [I2].Resize(N, 4)
'↑以下是關於[I2]擴展向下N變數列,擴展向右4欄儲存格範圍的程序
     .Columns(2).NumberFormatLocal = "#,##0 ;-#,##0 "
     '↑令這範圍儲存格第2欄格式要顯示千分位符號(,)
     .Columns(3).HorizontalAlignment = xlCenter
     '↑令這範圍儲存格第3欄儲存格值 水平對齊方式置中
     .Columns(4).NumberFormatLocal = "@"
     '↑令這範圍儲存格第4欄格式是文字
     .Borders.LineStyle = 1:  .Font.Size = 10
     '↑令這範圍儲存格框線是細實線
     '↑令這範圍儲存格文字大小為10
     .Value = Brr
     '↑令這範圍儲存格值以Brr陣列值帶入
End With

[D2].Resize(UBound(Arr)) = Arr '填入D欄對應值
'↑令[D2]擴展向下(Arr陣列最大索引號數列)儲存格範圍以Arr陣列值帶入
End Sub