參會名單
今天參會的有
張一山
張二山
張三山
張四山
張五山
參會名單
明天參會的有
王小虎
王大虎
還有其他各地來賓。。。。
參會名單
后天參會的有
李李
李也
李子
把紅字的部分找出來全剪切出來。
查找，替換功能好像滿足不了吧，是不是只能用VBA了？
uj5u.com熱心網友回復：
按你的用例看不就是剩余若干行 “參會名單”？為啥要洗掉紅色的？全選全刪，然后重復若干次參會名單即可
uj5u.com熱心網友回復：
只是舉個例子嘛。哈。實際上，肯定不是只有參會名單那幾個字
比如
。。。。。AAA參會名單。。。。。。
。。。xxxll參會名單3333。。。、
3322參會名單33111
那我就是我想保留紅字的部分。
uj5u.com熱心網友回復：
1、把所有你要的字串形成陣列（下稱關鍵字陣列）
2、設定指標，初始化指向檔案的第一個字符
3、取指標處的1個字符，到關鍵字陣列中比對，是否有與其中某個元素的第1個字符一致的關鍵字
3.1 如果有，則再取后續字符與關鍵字陣列匹配，如果后續字符能找到至少一個關鍵字完全匹配，則保留整個關鍵字，否則洗掉。
3.2 如果沒有，則洗掉指標處的字符
4、指標指向下一個字符，如果未到檔案結束goto 3 否則結束
uj5u.com熱心網友回復：
廢話說多招人嫌，給代碼吧。
Private Sub Command2_Click()
'需要進行處理的文本
Dim strTest As String
strTest = "這是一個測驗字串，其中包含若干個需要進行保留的關鍵字，希望函式處理后所有關鍵字都還在"
'關鍵字串列，其中故意插入了文本中不存在的關鍵字以及空元素，做測驗
Dim aryKey() As String
ReDim aryKey(0 To 3)
aryKey(0) = "測驗"
aryKey(1) = "關鍵字"
aryKey(2) = "串列"
'輸出結果
Debug.Print SearchKeys(strTest, aryKey)
End Sub
'處理函式，輸入需要檢查的文本及關鍵字串列
Private Function SearchKeys(strIn As String, keys() As String) As String
Dim i As Long, j As Long
For i = 1 To Len(strIn)
For j = LBound(keys) To UBound(keys)
If keys(j) = Mid(strIn, i, Len(keys(j))) Then
SearchKeys = SearchKeys & keys(j)
i = i + Len(keys(j))
DoEvents
End If
Next
Next
End Function
uj5u.com熱心網友回復：
感謝老師先~
一會上機實驗。
我會好好消化的。
uj5u.com熱心網友回復：
也可以用正則運算式:Sub test()
Dim strContent As String
strContent = ActiveDocument.Content.Text
Dim reg As Object
Set reg = CreateObject("vbscript.regexp")
reg.Global = True
reg.MultiLine = True
reg.ignorecase = True
reg.Pattern = "(AAA參會名單|xxxll參會名單3333|3322參會名單33111|參會名單)"
Dim colMatches As Object
Set colMatches = reg.Execute(strContent)
Dim strResult As String
strResult = ""
Dim objMatch As Object
For Each objMatch In colMatches
strResult = strResult & objMatch.Value & vbCrLf
Next
MsgBox strResult
End Sub
運行示例:
下載地址:
鏈接：https://pan.baidu.com/s/1xkyedz-9OLXFayN_KEgUzA
提取碼：wsc0
uj5u.com熱心網友回復：
首先回圈+查找紅色字體，利用 . found=true 判斷是否為紅色字體將selection的內容存入陣列，然后在通過回圈將陣列輸出存入一個變數中
轉載請註明出處，本文鏈接：https://www.uj5u.com/gongcheng/37024.html
標籤：VBA