打開excel文件複製內容到數組輸出這些項目到另一個結果文件

Question

我從來沒有在VBA編碼，但我試圖從obj-c轉置一些知識到這個。

-I要在每個第一個逗號之前打開一個文件（文件夾中的約200個文件）

-Look經過的小區中的每個文件

- 然後找到一切（字）的範圍內細胞（細胞在此範圍內有三個逗號）

每個單元的值-add到一個數組

（掃描剩餘的文件和執行相同）

- 結果數組並將它們全部粘貼到另一個名爲主列表的文件中

我想我已經介紹了大部分的內容（第一次使用VBA，雖然不太確定），但我還沒有想出如何讀取所有內容在每個單元中的第一個逗號

也請讓我知道，如果我有任何明顯的錯誤，或者邏輯發出

預先感謝您

謝謝您的幫助！

Sub CopyWordsToMainFileRow() 

Dim Cell As Range 
Dim counter As Integer 
Dim word As String 
Dim arrayOfIngredients() As Variant 'array of words from search 
Dim fileName As String 
Dim arrayOfFileNames As Variant 
Dim MainCounter As Integer 
Dim p As String, x As Variant 

MainCounter = 0 
counter = 0 

' Make array of file names 
    p = "/Users/waf04/Desktop/*.xls" 
    arrayOfFileNames = GetFileList(p) 

    Select Case IsArray(arrayOfFileNames) 
     Case True 'files found 
      MsgBox UBound(arrayOfFileNames) 
      Sheets("Sheet1").Range("A:A").Clear 
      For i = LBound(arrayOfFileNames) To UBound(arrayOfFileNames) 
       Sheets("Sheet1").Cells(i, 1).Value = arrayOfFileNames(i) 
      Next i 
     Case False 'no files found 
      MsgBox "No matching files" 
    End Select 
'end make array of file names 

'Create array from cells in each file 
For fileNameCounter = 0 To UBound(arrayOfFileNames) 

    fileName = arrayOfFileNames(MainCounter) 
    Workbooks.Open fileName:="fileName" 
    arrayOfIngredients = Range("AT2:EP200").Value 'add value of cells to array 

    'make array of results for each file 
    For Each Cell In Range("AT2:EP200") 
     word = Cell.Value ' make this string equal to the value of everything before the first comma in that cell 
     arrayOfIngredients(counter) = word 'add string to array 
     counter = counter + 1 
     Next Cell 

Workbooks.Close fileName:="fileName" 
Next fileNameCounter 
'============================== 
'Output unsorted array 
Workbooks.Open fileName:="/Users/waf04/Desktop/ingredients_collection.xlsx" 
Range("A1:A" & UBound(arrayOfIngredients) + 1) = _ 
WorksheetFunction.Transpose(arrayOfIngredients) 

End Sub 

Answer 1

這是您的代碼修改，以解決一些lgic問題，並顯示如何獲得字符串到第一個逗號。

這將從輸出文件的單個列中的每個文件輸出以逗號分隔的單詞列表。

我假設在所有情況下，每個工作簿中感興趣的工作表是index 1。您可能需要將其更改爲適合您的牀單。

注意：我已經在Windows機器上開發了它，它可能會在Mac上遇到問題，我不知道。

變化與註釋解釋' *** like this

Sub CopyWordsToMainFileRow() 
    Dim cell As Range 
    Dim counter As Long 'Integer *** no advanatge in using Integer, and risks overflow 
    Dim word As Variant 'String *** need variant for For Each loop 
    Dim arrayOfIngredients() As Variant 'array of words from search 
    Dim fName As String ' fileName As String *** dont use keywords as variables 
    Dim arrayOfFileNames As Variant 
    Dim MainCounter As Long 'Integer 
    Dim p As String, x As Variant 

    ' *** extra variables 
    Dim wb As Workbook 
    Dim ws As Worksheet 
    Dim arrayFromSheet As Variant 
    Dim CellValue As Variant 

    ' *** not used ? 
' MainCounter = 0 
' counter = 0 

    ' Make array of file names 
    p = "/Users/waf04/Desktop/*.xls" 
    arrayOfFileNames = GetFileList(p) 

    Select Case IsArray(arrayOfFileNames) 
     Case True 'files found 
      MsgBox UBound(arrayOfFileNames) 
      With Sheets("Sheet1") ' *** avoid multiple references to sheet 
       .Range("A:A").Clear 
'   For i = LBound(arrayOfFileNames) To UBound(arrayOfFileNames) 
'    Sheets("Sheet1").Cells(i, 1).Value = arrayOfFileNames(i) 
'   Next i 

      ' *** put file names into sheet in one step *** 
       .Range(.Cells(1, 1), .Cells(UBound(arrayOfFileNames) - LBound(arrayOfFileNames) + 1)) = arrayOfFileNames 
      End With 
     Case False 'no files found 
      MsgBox "No matching files" 
      ' ***** End Sub here. *** 
      Exit Sub 
    End Select 
    'end make array of file names 

    ' *** Initialise results array: Range("AT2:EP200") has 20099 cells 
    ReDim arrayOfIngredients(1 To 20099) ' <== you may want a more generic sizing solution 


    'Create array from cells in each file 
    'For fileNameCounter = 0 To UBound(arrayOfFileNames) 
    For fileNameCounter = LBound(arrayOfFileNames) To UBound(arrayOfFileNames) ' *** handle 0 or 1 based arrays 

     fName = arrayOfFileNames(fileNameCounter) ' MainCounter) *** use correct counter 
     Set wb = Workbooks.Open(fileName:=fName) ' *** use variable, use workbook object 
     Set ws = wb.Worksheets(1) ' *** use worksheet object, set to required sheet 
     ' *** don't overwrite prior results, so don't need this line 
     ' arrayOfIngredients = ws.Range("AT2:EP200") 'add value of cells to array 

     'make array of results for each file 
     ' *** don't loop over cells, get data into an array instead 
     arrayFromSheet = ws.Range("AT2:EP200") 
     counter = 1 ' *** initialise counter for each file 
     'For Each Cell In Range("AT2:EP200") 
     For Each word In arrayFromSheet 
      ' *** see new code below 
      'word = Cell.Value ' make this string equal to the value of everything before the first comma in that cell 
      i = InStr(word, ",") 
      If i > 0 Then 
       arrayOfIngredients(counter) = arrayOfIngredients(counter) & Left$(word, i - 1) & "," ' *** add string to array 
      Else 
       ' *** what to do if no , ??? 
      End If 
      counter = counter + 1 
     Next word 

     wb.Close SaveChanges:=False ' *** close object 
    Next fileNameCounter 
    '============================== 
    'Output unsorted array 
    ' *** strip trailing comma 
    For i = LBound(arrayOfIngredients) To UBound(arrayOfIngredients) 
     If Len(arrayOfIngredients(i)) > 0 Then 
      arrayOfIngredients(i) = Left$(arrayOfIngredients(i), Len(arrayOfIngredients(i)) - 1) 
     End If 
    Next i 
    Set wb = Workbooks.Open(fileName:="/Users/waf04/Desktop/ingredients_collection.xlsx") ' *** use object 
    wb.Worksheets(1).Range("A1:A" & UBound(arrayOfIngredients) - LBound(arrayOfIngredients) + 1) = _ 
    Application.Transpose(arrayOfIngredients) ' *** use object and use Application rather than Worksheet tramspose 

End Sub