我对VBA很陌生，所以不知道如何正确使用数组。
我正在尝试向数组中添加新值，因为我正在抓取文档，但不知道如何执行此操作..
rfr，chief等等一行...... 代码：
Sub DeleteNotOpsSheet()
Dim fPath As String
Dim fName As String
Dim wb As Workbook
Dim ws As Worksheet
Dim xWs As Worksheet
Dim rfr As String, chief As String, yard As String, tp As String
Dim Output As ThisWorkbook
Dim i As Long
Dim spath As String
'Which folder?
fPath = "\\hofiler1\fileserver\users\AChan\Documents\Scrape\manning\SEP"
'Check if slash included
If Right(fPath, 1) <> "\'" Then
fPath = fPath & "\"
End If
'Check for xlsm files
fName = Dir(fPath & "*.XLS")
'Turn of the screen
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'Loop until we run out of files
Do While fName <> ""
'Open the workbook
Set wb = Workbooks.Open(fPath & fName)
For Each xWs In wb.Worksheets
If xWs.Name = "ops sheet" Then '--> Getting an Object required error here
rfr = Left(ActiveWorkbook.Name, 11) & " - Reefer Foreman: " & WorksheetFunction.CountA(Range("P42"))
chief = Left(ActiveWorkbook.Name, 11) & " - Chief Foreman: " & WorksheetFunction.CountA(Range("V78"))
yard = Left(ActiveWorkbook.Name, 11) & " - Yard Foreman: " & WorksheetFunction.CountA(Range("AB74:AB81"))
tp = Left(ActiveWorkbook.Name, 11) & " - TPC Foreman: " & WorksheetFunction.CountA(Range("AB68"))
'NEED HELP HERE: I would like to append these values to sheet1 on ThisWorkbook
'Debug.Print rfr
'Debug.Print chief
'Debug.Print yard
'Debug.Print tp
End If
wb.Save
wb.Close True
Next
Application.DisplayAlerts = True
'delete all the others
'SaveChanges:=True, Filename:=newName
'Increment count for feedback
i = i + 1
'Get next file name
fName = Dir()
Loop
'turn screen back on
Application.ScreenUpdating = True
'Give feedback
MsgBox "All done." & vbNewLine & "Number of files changed: " & i, vbOKOnly, "Run complete"
End Sub
答案 0 :(得分：0)
最好使用数组并收集所有字符串并粘贴一次。我在没有检查语法的情况下写了这个，所以在你的文件中编写代码时检查它，但它显示了这个概念：
1 - 定义一些变量：
Dim counter as long
Dim arr() as variant
2 - 在你的循环之前：
counter=1
ReDim arr(1 to 4, 1 to counter)
循环内部：
arr(1, counter)=rfr
arr(2, counter)=chief
arr(3, counter)=yard
arr(4, counter)=tp
counter=counter+1
ReDim Preserve arr(1 to 4, 1 to counter)
4 - 循环后：
arr=Application.WorksheetFunctions.Transpose(arr)
Thisworkbook.Sheets("Sheet1").Range("A1").Resize(Ubound(arr,1),Ubound(arr,2)).Value=arr
答案 1 :(得分：0)
要将数据写入sheet1，我建议：
a）声明一个变量来跟踪你要写入的行
Dim rowOut As Long
b）每次你去写一个新行，增加变量
c）将每个项目写入一个列，每个项目都有一个新行
rowOut = rowOut + 1: ThisWorkbook.Worksheets("Sheet1").Cells(rowOut, "A").Value = rfr
rowOut = rowOut + 1: ThisWorkbook.Worksheets("Sheet1").Cells(rowOut, "A").Value = chief
rowOut = rowOut + 1: ThisWorkbook.Worksheets("Sheet1").Cells(rowOut, "A").Value = yard
rowOut = rowOut + 1: ThisWorkbook.Worksheets("Sheet1").Cells(rowOut, "A").Value = tp
或将每个项目写入同一行的不同列
rowOut = rowOut + 1
ThisWorkbook.Worksheets("Sheet1").Cells(rowOut, "A").Value = rfr
ThisWorkbook.Worksheets("Sheet1").Cells(rowOut, "B").Value = chief
ThisWorkbook.Worksheets("Sheet1").Cells(rowOut, "C").Value = yard
ThisWorkbook.Worksheets("Sheet1").Cells(rowOut, "D").Value = tp
答案 2 :(得分：0)
我使用的是我之前写过的这个函数（带有单元测试的完整版本（也显示了用法） - 关注github链接modArrayAppend.bas）。它使用二次函数来根据需要增长数组（类似于Python中的字典），但是你需要做一个最后ReDim Preserve来完成修剪数组（这实际上是可选的 - 所以UBound()将返回正确的值）。
' Simulates Collection's append() behaviour by keeping track of the last element's
' index and dynamically expanding the array using quadratic function (to minimize
' in-memory copy actions thus increasing performance significantly). Use this function
' when the number of elements to be appended is unknown.
'
' After all append operations are complete array's size needs to be adjusted to fit
' the contents exactly with ReDim Preserve expression:
'
' ReDim Preserve arr(LBound(arr) To idx)
'
' After this idx may be reset.
'
' @param arr - dynamic array (can be unallocated or empty)
' @param idx - index of the last current element in arr. Initialize to any value at start.
' It will be incremented by the append function and passed back by
' reference. No special actions need to be done to maintain this element's
' value current - just keep passing it to the append function. It is done
' this way to keep arrayAppend() stateless (for the price of an extra argument).
' @param val - value to be appended to the array _after_ idx
Sub arrayAppend(arr As Variant, idx As Long, val As Variant)
Dim size As Long
If Not isArrayAllocated(arr) Then
' new un-allocated array - do initial sizing
ReDim arr(idx To idx)
arr(idx) = val
Else
' existing array
If idx >= UBound(arr) Then
size = UBound(arr) - LBound(arr) + 1
If UBound(arr) + size > idx Then
' we're over the array's UBound - double the size
ReDim Preserve arr(LBound(arr) To UBound(arr) + size)
Else
' if new index is far forward from the current UBound of the array
' take a bit of a conservative approach and extend the new array to
' idx + size
ReDim Preserve arr(LBound(arr) To UBound(arr) + (idx - UBound(arr)) + size)
End If
End If
idx = idx + 1
arr(idx) = val
End If
End Sub
' Returns TRUE if the array is allocated (either a static array or a dynamic array that has been
' sized with Redim) or FALSE if the array is not allocated (a dynamic that has not yet
' been sized with Redim, or a dynamic array that has been Erased). Static arrays are always
' allocated.
'
' The VBA IsArray function indicates whether a variable is an array, but it does not
' distinguish between allocated and unallocated arrays. It will return TRUE for both
' allocated and unallocated arrays. This function tests whether the array has actually
' been allocated.
'
' This function is just the reverse of IsArrayEmpty.
'
' @see http://www.cpearson.com/Excel/isArrayAllocated.aspx
' @see http://www.cpearson.com/excel/VBAArrays.htm
Public Function isArrayAllocated(arr As Variant) As Boolean
Dim n As Long
On Error Resume Next
' if Arr is not an array, return FALSE and get out.
If IsArray(arr) = False Then
isArrayAllocated = False
Exit Function
End If
' Attempt to get the UBound of the array. If the array has not been allocated,
' an error will occur. Test Err.Number to see if an error occurred.
n = UBound(arr, 1)
If Err.Number = 0 Then
' Under some circumstances, if an array is not allocated, Err.Number will be
' 0. To acccomodate this case, we test whether LBound <= Ubound. If this
' is True, the array is allocated. Otherwise, the array is not allocated.
If LBound(arr) <= UBound(arr) Then
' no error. array has been allocated.
isArrayAllocated = True
Else
isArrayAllocated = False
End If
Else
' error. unallocated array
isArrayAllocated = False
End If
End Function
P.S。：您也可以使用Collection。它具有.Add方法，允许您不断添加越来越多的值。集合的一个小缺点是，对于原始类型（字符串，整数等），它会执行一些额外的对象/变体转换和引用，而数组通常会稍微快一些。
答案 3 :(得分：0)
决定使用VBA的标准Collection添加另一个答案：
Option Explicit
Sub addStrings()
' create new empty collection
Dim c As New Collection
Dim s As Variant
' keep adding as many strings as you wish
c.Add "String1"
c.Add "String2"
c.Add "String3"
c.Add "String4"
' when the time comes to process strings
For Each s In c
Debug.Print s
Next s
End Sub
和输出：
String1
String2
String3
String4
希望这有帮助。
答案 4 :(得分：0)
当前代码在每次遍历工作表时保存每个工作簿（wb.Save在循环内）。
实际上看起来根本不需要保存工作簿。
此修订代码：
ops sheet后停止在工作表中循环（因为它不能再次发生）码
Sub DeleteNotOpsSheet()
Dim fPath As String
Dim fName As String
Dim wb As Workbook
Dim ws As Worksheet
Dim xWs As Worksheet
Dim rfr As String, chief As String, yard As String, tp As String
Dim Output As ThisWorkbook
Dim bVar As Boolean
Dim lFnum As Long
Dim i As Long
'Which folder?
'fPath = "\\hofiler1\fileserver\users\AChan\Documents\Scrape\manning\SEP"
fPath = "C:\temp\"
'Check if slash included
If Right(fPath, 1) <> "\'" Then
fPath = fPath & "\"
End If
lFnum = FreeFile
Open fPath & "dump.csv" For Output As lFnum
'Check for xlsm files
fName = Dir(fPath & "*.XLS")
'Turn of the screen
With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With
'Loop until we run out of files
Do While fName <> ""
'Open the workbook
Set wb = Workbooks.Open(fPath & fName)
For Each xWs In wb.Worksheets
If xWs.Name = "ops sheet" Then '--> Getting an Object required error here
rfr = Left$(ActiveWorkbook.Name, 11) & " - Reefer Foreman: " & WorksheetFunction.CountA(Range("P42"))
chief = Left$(ActiveWorkbook.Name, 11) & " - Chief Foreman: " & WorksheetFunction.CountA(Range("V78"))
yard = Left$(ActiveWorkbook.Name, 11) & " - Yard Foreman: " & WorksheetFunction.CountA(Range("AB74:AB81"))
tp = Left$(ActiveWorkbook.Name, 11) & " - TPC Foreman: " & WorksheetFunction.CountA(Range("AB68"))
Print #lFnum, rfr & "," & chief & "," & yard & "," & "tp"
bVar = True
Exit For
End If
Next
If bVar Then wb.Save
wb.Close True
Application.DisplayAlerts = True
'delete all the others
'SaveChanges:=True, Filename:=newName
'Increment count for feedback
i = i + 1
'Get next file name
fName = Dir()
Loop
Close lFnum
'turn screen back on
Application.ScreenUpdating = True
'Give feedback
MsgBox "All done." & vbNewLine & "Number of files changed: " & i, vbOKOnly, "Run complete"
End Sub