0

我从未在 VBA 中编码，但我正在尝试将 obj-c 中的一些知识转换为这个。

-我想打开一个文件（一个文件夹大约200个文件）

- 浏览每个文件中的单元格范围

- 然后找到每个单元格中第一个逗号之前的所有内容（单词）（此范围内的单元格有三个逗号）

- 将每个单元格的值添加到数组中

（扫描其余文件并执行相同操作）

-获取结果数组并将它们全部粘贴到另一个名为 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
4

1 回答 1

2

这是您修改的代码以解决一些逻辑问题并展示如何使字符串达到第一个逗号。

这会在输出文件的单个列中从每个文件中输出逗号分隔的单词列表。

我假设在所有情况下，每个工作簿中感兴趣的工作表都是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
于 2012-12-03T06:12:35.183 回答