Andy2483

回復 21# 准提部林


    '謝謝前輩
'這帖學到很多知識
'1.=HYPERLINK(), =HYPERLINK(""#xx"",""yy"")==HYPERLINK(""#工作表1!xx"",""yy"")
'2.更認識 字串變數裡保留 雙引號" 這字元
'3."[^A-Za-z\'-]" 正則文字規則---保留"英文字" + "單引號" + "-"
'4.精確的儲存格位置帶入陣列值

執行前:

下載 (102.05 KB)

2022-11-10 07:58

執行結果:

下載 (149.33 KB)

2022-11-10 07:58

Sub TEST_A1()
Dim Arr, Brr, xD, B, i&, j%, Fx$, CT$, T$, T1$, R&, C%, Cx%
'↑宣告變數
Set xD = CreateObject("Scripting.Dictionary")
'↑令 xD是字典
Call 清除 '清除E列右方內容
'↑執行 Sub 清除() 副程式

Arr = Range([h1], [h65536].End(xlUp)).Resize(, 200)
'↑令Arr是陣列!倒入[H1]到H欄最後一個有內容儲存格再往右擴展200欄(到了GY欄)
For i = 2 To UBound(Arr)
'↑設順迴圈!從2 到Arr陣列縱向最後列號
    T = LCase(Trim(Arr(i, 1)))
    '↑先將Arr陣列的第一欄迴圈列去除前後空格後,
    '再把剩下的字串裡的英文字母轉小寫
    If T <> "" Then xD(T) = i
    '↑如果T字串不是空的!就將T字串當key(鍵)納入字典, item是迴圈數也是(工作表的列號)  '@@
    'T也是後面程序要用的關鍵字
Next i
Fx = "=HYPERLINK(""#xx"",""yy"")"  '超連結公式共用字串--xx替換為位址--yy替換為要顯示文字
'↑令Fx字串是 "=HYPERLINK("#xx","yy")"
'↑藉此帖學習如何讓字串變數裡保留 雙引號" 這字元!
'研究結果:先從該行程式碼頭尾各去除掉一個 " ,以下是細節
'1.剩下的字元 =HYPERLINK(""#xx"",""yy""),連續的""會保留一個",成為變數裡的"字元!
'   成為 =HYPERLINK("#xx","yy")
'2.要注意如果分配到最後剩下一個"字元 ,是不允許的!
'  例如 MsgBox "1""是錯的!但是VBA會幫補1個",變成 MsgBox "1"""  (去除頭尾",剩1"",最後顯示1")
'3.非雙引號字元之間分配間隔剩下一個"字元,也是不允許的!
'  例如MsgBox "1"2"是錯的! (去除頭尾",剩1"2,只剩中間一個",會出現編譯錯誤訊息),
'  MsgBox "1"2""也是錯的!  改為  MsgBox "12"""  訊息窗 12",改為  MsgBox "1""2"  訊息窗 1"2
'4.MsgBox """1""2""3""4"  ,訊息窗 "1"2"3"4

CT = "[^A-Za-z\'-]"  '文字規則---保留"英文字" + "單引號" + "-"
'↑令CT 是字串 "[^A-Za-z\'-]"  ,
'如何讓字串變數裡保留 單引號' 這字元?? 字串的頭尾有雙引號包夾住就可以
Brr = Range([b1], [a65536].End(xlUp))
'↑令Arr是陣列!倒入[B1]與A欄有內容儲存格間 擴展為最小方正區域儲存格的值
For i = 2 To UBound(Brr)
'↑設外順迴圈!從 2到Brr陣列縱向最後列號
    T = Trim(正則轉換(LCase(Brr(i, 2)), " ", CT))
    '↑將文字轉小寫,並以正則將不要的文字替換空格後傳回
    '令T是Brr陣列裡第二欄迴圈列的被處理過的值! 如何處理??
    '先將原值字串轉換為小寫做為 正則轉換()自訂義函數的被正則字串,取代文字是空白字元,
    '規則字符是 CT = "[^A-Za-z\'-]"
    '正則之後再去掉字串頭尾的空白字元
    For Each B In Split(T, " ") '以空格分拆單字
    '↑設內順迴圈!令 B 是 一維陣列裡的一員!
    '哪來的一維陣列? 正則之後的字串用 空白字元分割就是一維陣列
        R = xD(B & "")
        '↑令B變成字串後當key(鍵)!查字典裡的item是什麼? 丟給R 長整數裝著!
        '如果不是初始值 0 就是長整數(工作表的列號) '在前面@@標註位置
        If R = 0 Then GoTo b01
        '↑如果 R=0, 表示不是關鍵字或空格. 略過! 就跳到 b01的位置繼續執行
        T1 = B & "|" & i
        '↑令T1字串是 B字串 & "|" & 外迴圈數的組合字串(以下稱B|i組合字串)!
       '關鍵字+i列號...用于排除同一列字串出現相同關鍵字一次以上
        xD(T1) = xD(T1) + 1
        '↑令 B|i組合字串 當key ,item累加 1
        If xD(T1) > 1 Then GoTo b01
        '↑同一字串出現1次以上, 不再處理, 略過! 就跳到 b01的位置繼續執行
        Arr(R, 2) = Arr(R, 2) + 1
       '↑令Arr陣列的第二欄(關鍵字所在的列)位置累加 1
        C = Arr(R, 2)
       '↑令C是 次數累計
        Arr(R, C + 2) = Replace(Replace(Fx, "xx", "A" & i), "yy", Brr(i, 1))
        '↑由左而右填入"題號"...替代成超連公式
       'Arr陣列裡關鍵字所在的列號(次數累計+2欄)的位置填入 Fx被處理過的字串
        'Fx怎麼被處理??  Fx這變數在前方早就被定義為固定變數 "=HYPERLINK("#xx","yy")"
        '在此處只是每個符合判斷式的迴圈,拿它出來變為想要的超連結公式的文字串
        '因為此文字串的前方 = 在 Arr陣列裡就只是字元! 最後面程序貼到儲存格裡會變成超連結公式
        If C > Cx Then
       '↑Cx如果次數累計 大於 Cx(這不知道是什麼的短整數??) (Cx的初始值是 0)
           Cx = C
          '↑Cx是要裝入 C次數累計加 1的數字!
          '多這個 Cx變數另一個目的是為了要的在後面程序中精確的儲存格位置貼入值
           Arr(1, C + 2) = "題號-" & Cx
           '↑標題列加序號
        End If
b01: Next
i01: Next i
Arr(1, 2) = "次數"
If Cx = 0 Then Exit Sub
'↑如果沒有資料!就結束執行
With [h1].Resize(UBound(Arr), Cx + 2)
'↑接下來是關於[H1]儲存格向下擴展Arr陣列縱向最大列號,向右擴展 標題列_題號序號再加 2 欄
   .Value = Arr
   '↑將Arr陣列值從 [h1]開始帶入
   .EntireColumn.AutoFit
   '↑這些欄位自動調整欄寬
End With
End Sub