[發問] 請教如何擷取文章中各段落的某些文字??

dennislin

各位高手 好:

因為工作報告的關係，必須擷取一篇文章中各段落的某些文字，並計算次數。
想請教一下各位高手如何以函數或巨集設定某些文字，由各段落擷取出來。

例如，下面文章中(有三段落)設定要擷取的文字是"關節、骨頭"等，各段落經擷取後結果為，第一段:關節，第二段:骨頭、關節，第三段:骨頭、關節。

麻煩各位高手不吝告知，感謝。

   (第一段)民眾從歐美旅行歸國時常買「維骨力」孝敬長輩，但營養師提醒，「維骨力」功效是保護關節，成分並沒有鈣，別補錯了。

　(第二段)台北市立聯合醫院忠孝院區營養師洪若樸今天表示，許多民眾常搞不清楚保養骨頭及關節所需要的飲食。她在門診諮詢常被病人問，「骨質疏鬆要補維骨力嗎？一天吃幾顆？」

　(第三段)洪若樸指出，一般人看到維骨力中的「骨」字，就以為吃了可以「補骨」。但其實，最好將「骨頭」和「關節」搞清楚，基本上，「維骨力」是顧「關節」，成分中完全沒有鈣，如果拿維骨力來補鈣，就大錯特錯。

luhpro

各位高手 好:

因為工作報告的關係，必須擷取一篇文章中各段落的某些文字，並計算次數。
想請教一下各位 ...
dennislin 發表於 2013-10-17 22:26

1. Sub nn()
   
2.   Dim iI%
   
3.   Dim sStr(1 To 3) As String, sSer$
   
4.   Dim lPos1&, lNum1&, lPos2&, lNum2&, lLen&
   
5.   
   
6.   sStr(1) = "民眾從歐美旅行歸國時常買「維骨力」孝敬長輩，但營養師提醒，「維骨力」功效是保護關節，成分並沒有鈣，別補錯了。"
   
7.   sStr(2) = "台北市立聯合醫院忠孝院區營養師洪若樸今天表示，許多民眾常搞不清楚保養骨頭及關節所需要的飲食。她在門診諮詢常被病人問，「骨質疏鬆要補維骨力嗎？一天吃幾顆？」"
   
8.   sStr(3) = "洪若樸指出，一般人看到維骨力中的「骨」字，就以為吃了可以「補骨」。但其實，最好將「骨頭」和「關節」搞清楚，基本上，「維骨力」是顧「關節」，成分中完全沒有鈣，如果拿維骨力來補鈣，就大錯特錯。"
   
9.   sSer = ""
   
10.   For iI = 1 To 3
    
11.     lLen = Len(sStr(iI))
    
12.     lNum1 = 0
    
13.     lNum2 = 0
    
14.     lPos1 = 1
    
15.     lPos2 = 1
    
16.     Do While lPos1 <> 0 Or lPos2 <> 0
    
17.       If lPos1 > 0 Then
    
18.         If lPos1 = 1 Then lPos1 = 0
    
19.         lPos1 = InStr(lPos1 + 1, sStr(iI), "關節")
    
20.         If lPos1 <> 0 Then lNum1 = lNum1 + 1
    
21.       End If
    
22.       If iI > 1 Then
    
23.         If lPos2 > 0 Then
    
24.           If lPos2 = 1 Then lPos2 = 0
    
25.           lPos2 = InStr(lPos2 + 1, sStr(iI), "骨頭")
    
26.           If lPos2 <> 0 Then lNum2 = lNum2 + 1
    
27.         End If
    
28.       Else
    
29.         lPos2 = 0
    
30.       End If
    
31.     Loop
    
32.     If sSer <> "" Then sSer = sSer & Chr(10) & Chr(10)
    
33.     sSer = sSer & "第 " & iI & " 段 : "
    
34.     If iI > 1 Then sSer = sSer & "(骨頭) 找到 " & lNum2 & " 次, "
    
35.    
    
36.     sSer = sSer & "(關節) 找到 " & lNum1 & " 次"
    
37.   Next iI
    
38.   MsgBox sSer
    
39. End Sub

複製代碼

有一點須留意的 : InStr 的字串搜尋起始位置不得為 0

Hsieh

回復 1# dennislin

B2=(LEN($A2)-LEN(SUBSTITUTE($A2,B$1,"")))/LEN(B$1)
   

下載 (17.23 KB)

2013-10-18 14:35

ML089

回復 1# dennislin

B2
=(LEN($A2)-LEN(SUBSTITUTE($A2,B$1,)))/LEN(B$1)
又拉下拉複製公式

下載 (60.08 KB)

2013-10-18 14:47

dennislin

謝謝大家。另外，是否能將各段落內容，經函數或巨集擷取後的特定文字部分，呈現如附件所示，再請各位高手不吝告知。

dennislin

回復 5# dennislin


    擷取特定文字.rar (4.24 KB)

下載次數: 4

2013-10-20 07:33

不好意思，沒夾上附件。

luhpro

回復 6# dennislin
依照欲擷取的文字於字串中出現的順序依序顯示出來 :

1. Private Sub cbCatch_Click()
   
2.   Dim iI%, iK%
   
3.   Dim lPos&, lLen&, lRows&
   
4.   Dim sSer$, sStr$, sCat() As String
   
5.   
   
6.   lRows = 3
   
7.   Do While Cells(lRows, 1) <> ""
   
8.     For iI = 2 To 3
   
9.       sCat = Split(Cells(2, iI), "、")
   
10.       sStr = Cells(lRows, 1)
    
11.       lLen = Len(sStr)
    
12.       For lPos = 1 To lLen
    
13.         For iK = 0 To UBound(sCat)
    
14.           If Mid(sStr, lPos, Len(sCat(iK))) = sCat(iK) Then
    
15.             sSer = Cells(lRows, iI)
    
16.             If sSer <> "" Then sSer = sSer & "、"
    
17.             sSer = sSer & sCat(iK)
    
18.             Cells(lRows, iI) = sSer
    
19.             lPos = lPos + 1
    
20.           End If
    
21.         Next iK
    
22.       Next lPos
    
23.     Next iI
    
24.     lRows = lRows + 1
    
25.   Loop
    
26. End Sub

複製代碼

擷取特定文字-a.zip (12.01 KB)

下載次數: 5

2013-10-20 20:16