將文字檔中特定的字串，複製到excel中

擷取文字

kiwi0606 2021-05-19 18:10:56 ‧ 906 瀏覽

分享至

各位高手們您們好

有多個文字檔(從網頁另存成html檔)，裡面有機械領域的各家廠商及領域介紹，由於要做類別的統計，是否有方法可以快速的從文字檔中擷取特定的字串，然後複製到excel中，或是將擷取的字串存成另一個word檔也可以。

例如，擷取包含公司＋由公司往前算10個字元的字串

感謝協助。

deh iT邦研究生 1 級 ‧ 2021-05-19 22:27:55 檢舉

輸出到Excel用Epplus，擷取包含公司＋由公司往前算10個字元的字串用Regex。但做出來算是有門檻的。看有沒有其他大老直接幫你寫好，或知道現成工具，或者直接用巨集做好。

小魚 iT邦大師 1 級 ‧ 2021-05-20 07:31:08 檢舉

不能直接複製貼上嗎?

japhenchen iT邦超人 1 級 ‧ 2021-05-20 07:58:52 檢舉

如果是複雜的資料，建議用c#/VB+epplus或python+openXYL或phpExcel

登入發表討論

直播研討會

{{ item.channelVendor }} {{ item.webinarstarted }} |

直播中

1 個回答

海綿寶寶

iT邦大神 1 級 ‧ 2021-05-20 12:06:32

VBA 方式如下:
1.複製貼上以下程式碼
2.修改第1列到第5列以配合你的電腦
3.執行 MainLoop (按 F5)
4.結果會存在 A 欄

Const gPath = "D:\data\html\"   'HTML 檔的路徑
Const gExtension = ".html"      'HTML 檔的副檔名
Const gFind = "公司"            '要搜尋的關鍵字
Const gOffset = 10              '往前算 10 個字元，即位置
Const gGetLength = 10           '要抓幾個字元，即長度
Sub MainLoop()
    arrFiles = ListFiles(gPath)
    For nI = 1 To UBound(arrFiles) - 1
        sCompany = ReadOneFile(gPath & arrFiles(nI))
        Debug.Print sCompany
        PutOneWord (sCompany)
    Next nI
End Sub
Sub PutOneWord(ByVal sWord)
    Range("A65535").End(xlUp).Offset(1, 0).Select
    ActiveCell.Value = sWord
End Sub
Function ReadOneFile(ByVal strFilename) As String
    Dim strFileContent As String
    Dim iFile As Integer: iFile = FreeFile
    
    Open strFilename For Input As #iFile

    Dim barr() As Byte
    barr = InputB(LOF(1), 1)
    S = ""
    For i = LBound(barr) To UBound(barr)
        If barr(i) >= 128 Then
            S = S + Chr(CLng(barr(i)) * 256 + barr(i + 1))
            i = i + 1
        Else
            S = S + Chr(barr(i))
        End If
    Next
    strFileContent = S
    
    mPos = InStr(1, strFileContent, gFind, vbTextCompare)
    If mPos <> 0 Then
        ReadOneFile = Mid(strFileContent, mPos - gOffset, gGetLength)
    Else
        ReadOneFile = "找不到 " & gFind & " 文字"
    End If
    
    Close #iFile
End Function
Function ListFiles(ByVal sPath As String)

    Dim vaArray     As Variant
    Dim i           As Integer
    Dim oFile       As Object
    Dim oFSO        As Object
    Dim oFolder     As Object
    Dim oFiles      As Object

    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set oFolder = oFSO.GetFolder(sPath)
    Set oFiles = oFolder.Files

    If oFiles.Count = 0 Then Exit Function

    ReDim vaArray(1 To oFiles.Count)
    i = 1
    For Each oFile In oFiles
        If Right(oFile.Name, Len(gExtension)) = gExtension Then
            vaArray(i) = oFile.Name
            i = i + 1
        End If
    Next
    ReDim Preserve vaArray(1 To i)

    ListFiles = vaArray

End Function