- 帖子
- 1446
- 主題
- 40
- 精華
- 0
- 積分
- 1470
- 點名
- 0
- 作業系統
- Windows 7
- 軟體版本
- Excel 2010 & 2016
- 閱讀權限
- 50
- 性別
- 男
- 來自
- 台灣
- 註冊時間
- 2020-7-15
- 最後登錄
- 2024-10-21
|
23#
發表於 2022-11-10 08:11
| 只看該作者
本帖最後由 Andy2483 於 2022-11-10 08:17 編輯
回復 21# 准提部林
'謝謝前輩
'這帖學到很多知識
'1.=HYPERLINK(), =HYPERLINK(""#xx"",""yy"")==HYPERLINK(""#工作表1!xx"",""yy"")
'2.更認識 字串變數裡保留 雙引號" 這字元
'3."[^A-Za-z\'-]" 正則文字規則---保留"英文字" + "單引號" + "-"
'4.精確的儲存格位置帶入陣列值
執行前:
執行結果:
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 |
|
發表於 2022-2-20 13:01
| 
