读取txt文件并将所有单词放入字典

Question

到目前为止，我一直致力于创建一个可以读取 .txt 文档并随后将每个单词作为键输入的 VBScript。

如果让我们说“你好”在文本中出现 10 次，我希望值为 10。 它是大字母还是小字母都没有关系。像“你好/你好”或者如果有。 , ? ！在词尾。

例子：

“曾经有一个小孩，世界上只有小孩！”

这里我想要输出。

Key:   Value:
Once:    1
There:   1
Was:     1
A:       1
Little:  1
Child:   2
The:     1

等等。

现在我被困在将其放入带有键和值的字典中的部分。 如果这个词出现不止一次，我想检查这个词是否存在，如果不存在，则创建键并赋予值 1。如果它已经存在，则增加值。

Const ForReading = 1

Dim strcontents
Dim objfile
dim Place
Dim dictPerson

Set  dictPerson  = CreateObject("Scripting.Dictionary")

Place = InputBox("File Place","Place:",     "C:\text.txt") 

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(Place, ForReading)
strContents = objFile.ReadAll
objFile.Close

i = i + 1

arrLines = Split(strContents, " ")

For Each strLine in arrLines
  'WScript.Echo (strline) 
Next

编辑：

这是我的结局代码？

我给了我一个“错误”的输出。

 Option Explicit 
 Const ForReading = 1

 Dim DictPerson
 Dim Placering
 Dim OBJFile
 Dim OBJFSO
 Dim Strcontents
 Dim Arrlines
 Dim StrLine
 Dim Re
 Dim Word
 Dim list
 Dim Key
 list = ""

 Set DictPerson = CreateObject("Scripting.Dictionary")
 DictPerson.CompareMode = vbTextCompare

 Placering = InputBox("Indtast Placering på filen!","Placering:",           "C:\Users\TEV-E311\Desktop\Eksamen\olsenbanden.txt") 

 Set OBJFSO = CreateObject("Scripting.FileSystemObject")
 Set OBJFile = OBJFSO.OpenTextFile(Placering, ForReading)
 Strcontents = OBJFile.ReadAll
 OBJfile.Close


 Arrlines = Split(Strcontents, " ")


 Set Re = New RegExp
     Re.Pattern = "^(.*)[.:,;!?-]$"

 For Each StrLine In Arrlines
    For Each Word In Split(StrLine)
        Word = Re.Replace(Word, "$1")
        DictPerson(Word) = DictPerson(Word) + 1
    Next    
 Next

            For Each key In dictPerson.Keys
            list = list & key & ":" & vbTab & dictPerson(key) & vbNewLine
            Next

这看起来正确吗？

输出的第一行是孔线而不是前两个单词？ （第一行写着 Egon Olsen）在我的输出中还写着 Egon Olson？

输出：

Microsoft (R) Windows Script Host 5.8 版 版权所有 (C) Microsoft Corporation 1996-2001。 Alle rettigheder forbeholds.

 Egon:  2
 Olsen
 Jeg:   1
 har:   6
 Han:   1
 var:   3
 aldeles:   1
 svensker:  1
 han:   1
 bare:  1
 almindelig:    1
 fuld
 Benny: 1
 Frandsen
 Skide: 1
 godt:  1
 Egon!
 Egon:  1
 fanden.
 Den:   1
 go':   1
 nok:   1
 Egon!
 Hva':  1
 faan:  2
 sgu:   1
 fyldt: 1
 femmer!
 så:    1
 rolig: 1
 nu:    3
 Egon
 "Gode: 1
 gamle: 1
 Franz.
 Hva´:  1
 taget: 1
 røven: 1
 dig:   2
 igen:  1
 ?
 Så:    1
 Keld:  1
 jo:    3
 ment
 Du:    1
 smælderfed:    1
 mand!
 Yvonne:    1
 Jensen
 Der:   1
 kommer:    2
 et:    1
 tidspunkt: 1
 enhver:    1
 kvindes:   1
 liv:   1
 hvor:  1
 hun:   1
 må:    1
 blomstre:  1
 folde: 1
 sig:   1
 ud.
 Nej.:  1
 siger: 1
 Egon.
 Ja,:   1
 Vorherre:  1
 bevares.
 Du:    1
 lovede:    1
 skulle:    1
 millionærer.
 Meget: 1
 du:    1
 budt:  1
 gennem:    1
 alle:  1
 disse: 1
 år.
 ..og:  1
 når:   1
 vores: 1
 alder: 1
      kun:  1
 resten:    1
 livet: 1
 tilbage.
 :  1


 ***** script completed - exit code: 0 *****

这只是部分代码，因为有 363 个单词。 但是您可以看到它为 Hello 和 hello 创建了一个 Key（示例）？竟然是同一个字？

而且它不会删除 .,?!从一些话？ + 在第一行，它把 Egon Olsen 变成了一个词？我在那里做错了什么？

如果有人想要文本，我也可以上传，但它是丹麦语.... :)

Answer 1

Split每一行，去掉尾部标点，然后将单词添加到字典中：

Set re = New RegExp
re.Pattern = "^(.*)[.:,;!?´-]+$"

For Each strLine In arrLines
  For Each word In Split(strLine)
    word = re.Replace(word, "$1")
    dictPerson(word) = dictPerson(word) + 1
  Next
Next

将字典的CompareMode 属性设置为vbTextCompare 使键不区分大小写：

Set dictPerson = CreateObject("Scripting.Dictionary")
dictPerson.CompareMode = vbTextCompare

附带说明，我建议在循环中使用ReadLine 而不是ReadAll 和Split：

Set objFile = objFSO.OpenTextFile(Place, ForReading)
Do Until objFile.AtEndOfStream
  strLine = objFile.ReadLine
  ...
Loop
objFile.Close

这样您一次处理一行，而不是一次读取整个内容，这对于大文件可能非常消耗内存。

编辑：要显示结果，您可以（例如）执行以下操作：

list = ""
For Each key In dictPerson.Keys
  list = list & key & ":" & vbTab & dictPerson(key) & vbNewLine
Next
WScript.Echo list