如何从文本文件中提取特定的单词到xls电子表格中

我是VBA新手。 在这里发布我的问题之前，我花了近3天的时间浏览互联网。

我有300多个文本文件（使用OCR从PDF转换的文本），从文本文件。 我需要将所有包含“字母”和“数字”的单词（例如KT315A，KT-315-a等）与源参考（txt文件名）一起获得。

我需要的是

1.添加“智能filter”，将只复制包含的单词
“字母”和“数字”

2. 将复制的数据粘贴到A列

3. 将参考文件名称添加到B列

我发现下面的代码可以将文本文件中的所有数据复制到Excel电子表格中。

文本文件看起来像

“从252A-552A到ddddd，,,, @，@，rrrr，22，…. kt3443，fff ,,,等”

xls的最终结果应该是

A | 乙

252A-552A | 文件1

kt3443 | 文件1

Option Explicit Const sPath = "C:\outp\" 'remember end backslash Const delim = "," 'comma delimited text file - EDIT 'Const delim = vbTab 'for TAB delimited text files Sub ImportMultipleTextFiles() Dim wb As Workbook Dim sFile As String Dim inputRow As Long RefreshSheet On Error Resume Next sFile = Dir(sPath & "*.txt") Do Until sFile = "" inputRow = Sheets("Temp").Range("A" & Rows.Count).End(xlUp).Row + 1 'open the text file 'format=6 denotes a text file Set wb = Workbooks.Open(Filename:=sPath & sFile, _ Format:=6, _ Delimiter:=delim) 'copy and paste wb.Sheets(1).Range("A1").CurrentRegion.Copy _ Destination:=ThisWorkbook.Sheets("Temp").Range("A" & inputRow) wb.Close SaveChanges:=False 'get next text file sFile = Dir() Loop Set wb = Nothing End Sub Sub RefreshSheet() 'delete old sheet and add a new one On Error Resume Next Application.DisplayAlerts = False Sheets("Temp").Delete Application.DisplayAlerts = True Worksheets.Add ActiveSheet.Name = "Temp" On Error GoTo 0 End Sub 

谢谢！

Answer 1

从你的例子中确切地说出一个词的构成有点困难。 它显然可以包含字母和数字以外的字符（例如短划线），但是其中一些项目之前有点，因此不能将其定义为由space分隔。

我将一个“单词”定义为一个string

• 以字母或数字开始，以字母或数字结尾
• 包含字母和数字
  • 可能还包含除逗号之外的其他任何非空格字符

为此，我首先用空格replace所有逗号，然后应用适当的正则expression式。 但是，这可能会接受不想要的string，所以您可能需要更具体地定义一个字是什么。

而且，不用将整个文件读入Excel工作簿，而是通过使用FileSystemObject我们可以一次处理一行，而无需将300个文件读入Excel。 基本文件夹与VBA代码中的常量一样，也是如此。

但还有其他方法可以做到这一点。

请确保为代码中提到的早期绑定设置引用：

---

 Option Explicit 'Set References to: ' Microsoft Scripting Runtime ' Microsoft VBscript Regular Expressions 5.5 Sub SearchMultipleTextFiles() Dim FSO As FileSystemObject Dim TS As TextStream, FO As Folder, FI As File, FIs As Files Dim RE As RegExp, MC As MatchCollection, M As Match Dim WS As Worksheet, RW As Long Const sPath As String = "C:\Users\Ron\Desktop" Set FSO = New FileSystemObject Set FO = FSO.GetFolder(sPath) Set WS = ActiveSheet WS.Columns.Clear Set RE = New RegExp With RE .Global = True .Pattern = "(?:\d(?=\S*[az])|[az](?=\S*\d))+\S*[az\d]" .IgnoreCase = True End With For Each FI In FO.Files If FI.Name Like "*.txt" Then Set TS = FI.OpenAsTextStream(ForReading) Do Until TS.AtEndOfStream 'Change .ReadLine to .ReadAll *might* make this run faster ' but would need to be tested. Set MC = RE.Execute(Replace(TS.ReadLine, ",", " ")) If MC.Count > 0 Then For Each M In MC RW = RW + 1 WS.Cells(RW, 1) = M WS.Cells(RW, 2) = FI.Name Next M End If Loop End If Next FI End Sub 

---