如何閱讀免費的文字和商店價值？

Question

我有一個很大的excel工作簿，有幾列。

我想通過一列（包含自由文本）並將每個單詞存儲在一個新工作表中。 （不是唯一的。）

樣本數據（源片）：

|------A-------||------B-------||------C-------| 
    | John   ||1234   ||I like stuff | 
    | John   ||1235   ||He like stuffs| 
    | John   ||1236   ||I like cats | 
    | Jack   ||1237   ||I like dogs | 
    | John   ||1238   ||I like cats | 

預期輸出（新板） - 我然後操縱該數據以計數值的頻率：

|------A-------| 
    | I   | 
    | like   | 
    | stuff  | 
    | He   | 
    | like   | 
    | ..   | 
    | cats   | 

推薦方法：

• 第一個循環經過並將所有值存儲到單個字符串中。那麼字符串可以拆分並插入到新的工作表中？下面的代碼會將所有字段捕獲到一個文本文件中。
• 第一個循環遍歷每個單元格，拆分值然後將拆分值插入到新工作表中？

它不一定需要在Excel中，它可以在Access中，因爲我正在跨兩個應用程序工作。更熟悉Excel VBA。

代碼字段爲文本文件或CSV：

Sub WriteTextFile() 

'http://www.homeandlearn.org/write_to_a_text_file.html 

Dim FilePath As String 
Dim CellData As String 
Dim LastCol As Long 
Dim LastRow As Long 

Sheets("test").Select 

LastCol = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Column 
LastRow = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row 

FilePath = Application.ActiveWorkbook.Path & "\auth.csv" 

Open FilePath For Output As #2 

    For i = 1 To LastRow 

     For j = 1 To LastCol 

      If j = LastCol Then 

      CellData = CellData + Trim(ActiveCell(i, j).Value) 

      Else 

      CellData = CellData + Trim(ActiveCell(i, j).Value) + "," 

      End If 

     Next j 

    Write #2, CellData 
    CellData = "" 

    Next i 

Close #2 
MsgBox ("Done") 


End Sub 

Answer 1

如果你想要做的是保存用於csv文件中的所有單詞的列表，你可以做到這一點相當簡單這樣 - 假設你的所有單詞都在列C中。請注意，在這種情況下，我硬編碼了文件名，但可以根據需要更改它。

Option Explicit 
Sub ListWords() 
    Dim vSrc As Variant, vRes() As Variant 
    Dim WS1 As Worksheet, WS2 As Worksheet 
    Dim V As Variant 
    Dim lNumWords As Long 
    Dim I As Long, J As Long, K As Long 
    Dim S As String 

Set WS1 = Worksheets("Sheet1") 
Set WS2 = Worksheets("Sheet2") 

'Get the column of free text 
With WS1 
    vSrc = .Range("C1", .Cells(.Rows.Count, "C").End(xlUp)) 
End With 

'Count words so as to dim results array 
With WorksheetFunction 
For I = 1 To UBound(vSrc, 1) 
    S = .Trim(vSrc(I, 1)) 
    lNumWords = lNumWords + Len(S) - Len(.Substitute(S, " ", "")) + 1 
Next I 

'Capture the words 
K = 0 
ReDim vRes(1 To lNumWords, 1 To 1) 
For I = 1 To UBound(vSrc, 1) 
    V = Split(.Trim(vSrc(I, 1)), " ") 
    For J = 0 To UBound(V) 
     K = K + 1 
     vRes(K, 1) = V(J) 
    Next J 
Next I 
End With 

With WS2.Range("a1").Resize(lNumWords) 
    .EntireColumn.Clear 
    .Value = vRes 
    .EntireColumn.AutoFit 
End With 

'Write results to a .csv file 
WS2.SaveAs Filename:="c:\users\ron\desktop\Auth", FileFormat:=xlCSV 

End Sub 

Answer 2

如果最終目標實際上是計算唯一的單詞出現次數，請看下面的代碼。它在一個新電子表格的列A中寫下每一個唯一的單詞 - 以及列B中的字數。

這假設C列中的字符串不包含標點符號 - 實際上，構成您的單詞字符串用空格，連字符或撇號分開

只需在給它一個試試之前在註釋中突出顯示的兩個部分中輸入您的工作表名稱。您還應該在工具 - >參考中添加對Microsoft腳本運行時庫的引用。

Sub splitNcount() 
    Dim D As Scripting.Dictionary 
    Dim a As Variant 
    Dim i As Integer 

    Set D = New Dictionary 

    D.CompareMode = TextCompare 

    'ENTER SHEET NAME HERE 
    For Each r In Worksheets("YOUR_SHEET_NAME").Range(Range("C1"), Range("C1").End(xlDown)) 
     mystr = Replace(r.Value, "'", " ") 
     mystr = Replace(mystr, "-", " ") 
     a = Split(mystr, " ") 

     On Error GoTo ERREUR 

     For Each elt In a 
      D.Add elt, 1 
     Next elt 

     On Error GoTo 0 
    Next r 

    i = 1 

    'ENTER SHEET NAME HERE 
    With Worksheets.Add(after:=Worksheets("YOUR_SHEET_NAME")) 
     For Each k In D 
      .Range("A" & i).Value = k 
      .Range("A" & i).Offset(0, 1).Value = D(k) 
      i = i + 1 
     Next k 
    End With 

    Exit Sub 

ERREUR: 

    D(elt) = D(elt) + 1 
    Resume Next 

End Sub