Board logo

標題: [發問] 請教如何擷取文章中各段落的某些文字?? [打印本頁]
作者: dennislin    時間: 2013-10-17 22:26     標題: 請教如何擷取文章中各段落的某些文字??

各位高手 好:

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

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

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

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

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

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

各位高手 好:

因為工作報告的關係，必須擷取一篇文章中各段落的某些文字，並計算次數。
想請教一下各位 ...
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    時間: 2013-10-18 14:36

回復 1# dennislin

B2=(LEN($A2)-LEN(SUBSTITUTE($A2,B$1,"")))/LEN(B$1)
    [attach]16369[/attach]
作者: ML089    時間: 2013-10-18 14:48

回復 1# dennislin

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

[attach]16370[/attach]
作者: dennislin    時間: 2013-10-20 07:32

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

回復 5# dennislin


    [attach]16381[/attach]

不好意思，沒夾上附件。
作者: luhpro    時間: 2013-10-20 20:16

本帖最後由 luhpro 於 2013-10-20 20:18 編輯

回復 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
複製代碼
[attach]16396[/attach]



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)