我从来没有在VBA编码，但我试图将一些知识从obj-c转换成这个。
- 我想打开一个文件（文件夹中大约200个文件）
- 查看每个文件中的单元格范围
- 然后在每个单元格中的第一个逗号之前找到所有内容（单词）（此范围内的单元格有三个逗号）
- 将每个单元格的值添加到数组
（扫描剩余的文件并执行相同操作）
-take results array并将它们全部粘贴到名为master list
的另一个文件中我想我已经涵盖了大部分内容（第一次使用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
答案 0 :(得分：2)
这是您的代码修订，以解决一些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