我是VBA的新手。根据我在这个论坛中发现的信息，我已经能够成功创建一个功能宏但仍有一些问题。宏的目的是从一个充满xls *文件的目录中构建数据集。工作得很好。非常感谢那些发布我开始的人。
问题在于每次执行时，它都会在新工作簿的Sheet1中创建答案集。我希望答案设置可以进入当前工作簿的当前工作表，也可以进入特定工作簿的“数据”表。在这种情况下，我真的希望答案集在宏所在的xlsm文件中。我找不到合适的解决方案了。更准确地说，我不明白为什么默认情况下这不是我当前的工作表，因为文档似乎表明它应该。
另一个问题。在下面的代码中，新手遵循/调整子代码相对简单。但是，有人可以解释（通常）私人功能代码吗？虽然它有效，但我在技术上很难理解它在做什么。
Sub ReadDataFromAllWorkbooksInFolder()
Dim FolderName As String, wbName As String, r As Long, cValue As Variant
Dim fs, f, s
Dim wbList() As String, wbCount As Integer, i As Integer, Lead As Integer
Dim CheckIN As Date, CheckOUT As Date
Dim Total As Currency, Deposit As Currency, Balance As Currency, STax As Currency, CTax As Currency, TTax As Currency
Dim Rent As Currency, Pet As Currency, Cleaning As Currency, HotTub As Currency
Dim BookDate As Date, Origin As Date
FolderName = "C:\Users\Ken\Documents\Personal\Ferguson House\Contracts\Sample"
' create list of workbooks in foldername' --- Comment
wbCount = 0
wbName = Dir(FolderName & "\" & "*.xls*")
While wbName <> ""
wbCount = wbCount + 1
ReDim Preserve wbList(1 To wbCount)
wbList(wbCount) = wbName
wbName = Dir
Wend
If wbCount = 0 Then Exit Sub
' get values from each workbook' --- Comment
r = 1
Workbooks.Add
For i = 1 To wbCount
r = r + 1
House = GetInfoFromClosedFile(FolderName, wbList(i), "Contract", "I1")
Name = GetInfoFromClosedFile(FolderName, wbList(i), "Contract", "c2")
Address = GetInfoFromClosedFile(FolderName, wbList(i), "Contract", "c3")
Phone = GetInfoFromClosedFile(FolderName, wbList(i), "Contract", "c4")
Fax = GetInfoFromClosedFile(FolderName, wbList(i), "Contract", "c5")
Email = GetInfoFromClosedFile(FolderName, wbList(i), "Contract", "c6")
Total = GetInfoFromClosedFile(FolderName, wbList(i), "Contract", "d10")
Deposit = GetInfoFromClosedFile(FolderName, wbList(i), "Contract", "d11")
Balance = GetInfoFromClosedFile(FolderName, wbList(i), "Contract", "d12")
STax = GetInfoFromClosedFile(FolderName, wbList(i), "Contract", "c55")
CTax = GetInfoFromClosedFile(FolderName, wbList(i), "Contract", "c56")
TTax = GetInfoFromClosedFile(FolderName, wbList(i), "Contract", "c57")
Rent = GetInfoFromClosedFile(FolderName, wbList(i), "Contract", "c51")
Pet = GetInfoFromClosedFile(FolderName, wbList(i), "Contract", "i16")
Cleaning = GetInfoFromClosedFile(FolderName, wbList(i), "Contract", "i14")
HotTub = GetInfoFromClosedFile(FolderName, wbList(i), "Contract", "i15")
CheckIN = GetInfoFromClosedFile(FolderName, wbList(i), "Contract", "i2")
CheckOUT = GetInfoFromClosedFile(FolderName, wbList(i), "Contract", "g44")
NIGHTS = GetInfoFromClosedFile(FolderName, wbList(i), "Contract", "i3")
BookDt = FolderName & "\" & wbList(i)
BookDate = FileDateTime(BookDt)
Origin = Int(BookDate)
Lead = CheckIN - Origin
Cells(r, 1).Value = wbList(i)
Cells(r, 2).Value = House
Cells(r, 3).Value = Name
Cells(r, 4).Value = Address
Cells(r, 5).Value = Phone
Cells(r, 6).Value = Fax
Cells(r, 7).Value = Email
Cells(r, 8).Value = Total
Cells(r, 9).Value = Deposit
Cells(r, 10).Value = Balance
Cells(r, 11).Value = STax
Cells(r, 12).Value = CTax
Cells(r, 13).Value = TTax
Cells(r, 14).Value = Rent
Cells(r, 15).Value = Pet
Cells(r, 16).Value = Cleaning
Cells(r, 17).Value = HotTub
Cells(r, 18).Value = CheckIN
Cells(r, 19).Value = CheckOUT
Cells(r, 20).Value = NIGHTS
Cells(r, 21).Value = Origin
Cells(r, 22).Value = Lead
Next i
'Create Headers
Range("$A$1").Value = "Contract"
Range("$B$1").Value = "House #"
Range("$C$1").Value = "Name"
Range("$D$1").Value = "Address"
Range("$E$1").Value = "Phone"
Range("$F$1").Value = "Fax"
Range("$G$1").Value = "Email"
Range("$H$1").Value = "Total"
Range("$I$1").Value = "Deposit"
Range("$J$1").Value = "Balance"
Range("$K$1").Value = "St Tax"
Range("$L$1").Value = "Cty Tax"
Range("$M$1").Value = "Tot Tax"
Range("$N$1").Value = "Rent Only"
Range("$O$1").Value = "Pet Fee"
Range("$P$1").Value = "Cleaning"
Range("$Q$1").Value = "Hot Tub"
Range("$R$1").Value = "Check In"
Range("$S$1").Value = "Check Out"
Range("$T$1").Value = "Nights"
Range("$U$1").Value = "Book Dte"
Range("$V$1").Value = "Lead Time"
Range("A1:V1").Font.Bold = True
End Sub
Private Function GetInfoFromClosedFile(ByVal wbPath As String, _
wbName As String, wsName As String, cellRef As String) As Variant
Dim arg As String
GetInfoFromClosedFile = ""
If Right(wbPath, 1) <> "\" Then wbPath = wbPath & "\"
If Dir(wbPath & "\" & wbName) = "" Then Exit Function
arg = "'" & wbPath & "[" & wbName & "]" & _
wsName & "'!" & Range(cellRef).Address(True, True, xlR1C1)
On Error Resume Next
GetInfoFromClosedFile = ExecuteExcel4Macro(arg)
End Function
答案 0 :(得分：1)
Workbooks.Add正在创建一个新的工作簿。
不合格的Cells对象，您可以将数据分配给＆＃34;当前＆＃34;工作表，将始终恢复到运行时活动的任何工作表。添加工作簿会使该书处于活动状态，默认情况下，Sheet1对象将在该工作簿中处于活动状态。
我怀疑只是摆脱Workbooks.Add将解决问题，但您可能需要进一步调整以明确激活您希望放置代码的工作表，例如：
With ThisWorkbook.Sheets("YOUR SHEET NAME") ' ## MODIFY AS NEEDED!
.Cells(r, 1).Value = wbList(i)
.Cells(r, 2).Value = House
.Cells(r, 3).Value = Name
.Cells(r, 4).Value = Address
.Cells(r, 5).Value = Phone
.Cells(r, 6).Value = Fax
.Cells(r, 7).Value = Email
.Cells(r, 8).Value = Total
.Cells(r, 9).Value = Deposit
.Cells(r, 10).Value = Balance
.Cells(r, 11).Value = STax
.Cells(r, 12).Value = CTax
.Cells(r, 13).Value = TTax
.Cells(r, 14).Value = Rent
.Cells(r, 15).Value = Pet
.Cells(r, 16).Value = Cleaning
.Cells(r, 17).Value = HotTub
.Cells(r, 18).Value = CheckIN
.Cells(r, 19).Value = CheckOUT
.Cells(r, 20).Value = NIGHTS
.Cells(r, 21).Value = Origin
.Cells(r, 22).Value = Lead
End With
注意：您也需要对标题分配执行相同的操作。
答案 1 :(得分：0)
如果您使用Cells(r, 1).Value或Range("$K$1").Value之类的引用，那么您想要的是ActiveSheet.Cells(r, 1).Value或ActiveSheet.Range("$K$1").Value。
解决方法是使用完全限定的引用。不要让Excel承担任何责任。
所以不要只做
Workbooks.Add
做
Dim myDestinationSheet As Worksheet
Dim myDestinationWorkbook As Workbook
Set myDestinationWorkbook = Workbooks.Add
Set myDestinationSheet = myDestinationWorkbook.Sheets(1)
myDestinationSheet.Name = "Data"
myDestinationSheet.Cells(1,1).value = House
您应该使用此技术来解决您编写的每行代码中对象引用中可能存在的歧义。即使你使用ActiveSheet，也许是默认值，最好明确地使用它。
答案 2 :(得分：0)
功能是一个很好的方法 - 这样做基本上可以节省您打开所需WB的时间，而不是直接检索数据。
在“正常”过程中，您需要
1.打开WB
2。选择纸张
3。获取所需的值
4.关闭WB
这个函数依赖于这样一个事实，即您可以在Excel中键入一个从闭合的wb中检索所需值的公式。您可以在ExcelSheet中='C:\MyUser\Documents\[DesiredWB.xls]Sheet1'!$A$2尝试自己 - >这比上面提到的4个步骤更快吗？
然而，这似乎是一个“快速修复”
我遇到了类似的情况，并提供了基本上相同的解决方案，但是，有更多的错误处理。 - 我会为“House”做例子
1.首先，验证WB中是否存在所需的纸张：
Function SheetExistsFDB(ShtName$, WbPath$) As Boolean
Dim GV, ParentFolder$, FileName$, PD%
'Split to folder and file name
PD = InStrRev(WbPath, "\")
ParentFolder = Left(WbPath, PD - 1)
FileName = Mid(WbPath, PD + 1)
' also can be used to get the value RV from a specified Row Col if you need it
GV = ExecuteExcel4Macro("'" & ParentFolder & "\[" & FileName & "]" & ShtName & "'!R1C1")
SheetExistsFDB = CStr(GV) <> "Error 2023"
' MsgBox CStr(GV)
End Function
2。使用此公式只需按照描述键入公式：
Sub WriteFormulasvalues(iFilePath As String, iFilename As String, iSheet As String, iRC As String, iRange As Range, Optional AdditionalText As String)
myFormula = "='" & iFilePath & "[" & iFilename & "]" & iSheet & "'!" & iRC & ""
With iRange
.Formula = myFormula
.Value = AdditionalText & .Value
End With
End Sub
由于所有变量都使用相同的名称表，我会使用类似
的内容For i = 1 To wbCount
Dim RealPath
RealPath = FolderName & wbList(i)
If SheetExistsFDB("Contract", RealPath) = True Then ' 1. If SheetExistsFDB(RealPath, "Contract") = True
r = r + 1
'House used as example correct others
Call WriteFormulasvalues(FolderName, wbList(i), "Contract", "R1C9", Cells(r, 2)) 'I used RC format so according to your code I1= R1C9
Name = GetInfoFromClosedFile(FolderName, wbList(i), "Contract", "c2")
Address = GetInfoFromClosedFile(FolderName, wbList(i), "Contract", "c3")
Phone = GetInfoFromClosedFile(FolderName, wbList(i), "Contract", "c4")
Fax = GetInfoFromClosedFile(FolderName, wbList(i), "Contract", "c5")
Email = GetInfoFromClosedFile(FolderName, wbList(i), "Contract", "c6")
Total = GetInfoFromClosedFile(FolderName, wbList(i), "Contract", "d10")
Deposit = GetInfoFromClosedFile(FolderName, wbList(i), "Contract", "d11")
Balance = GetInfoFromClosedFile(FolderName, wbList(i), "Contract", "d12")
STax = GetInfoFromClosedFile(FolderName, wbList(i), "Contract", "c55")
CTax = GetInfoFromClosedFile(FolderName, wbList(i), "Contract", "c56")
TTax = GetInfoFromClosedFile(FolderName, wbList(i), "Contract", "c57")
Rent = GetInfoFromClosedFile(FolderName, wbList(i), "Contract", "c51")
Pet = GetInfoFromClosedFile(FolderName, wbList(i), "Contract", "i16")
Cleaning = GetInfoFromClosedFile(FolderName, wbList(i), "Contract", "i14")
HotTub = GetInfoFromClosedFile(FolderName, wbList(i), "Contract", "i15")
CheckIn = GetInfoFromClosedFile(FolderName, wbList(i), "Contract", "i2")
CheckOut = GetInfoFromClosedFile(FolderName, wbList(i), "Contract", "g44")
NIGHTS = GetInfoFromClosedFile(FolderName, wbList(i), "Contract", "i3")
BookDt = FolderName & "\" & wbList(i)
BookDate = FileDateTime(BookDt)
Origin = Int(BookDate)
Lead = CheckIn - Origin
Cells(r, 1).Value = wbList(i)
'Cells(r, 2).Value = House no longer needed since WriterFormulas does it
Cells(r, 3).Value = Name
Cells(r, 4).Value = Address
Cells(r, 5).Value = Phone
Cells(r, 6).Value = Fax
Cells(r, 7).Value = Email
Cells(r, 8).Value = Total
Cells(r, 9).Value = Deposit
Cells(r, 10).Value = Balance
Cells(r, 11).Value = STax
Cells(r, 12).Value = CTax
Cells(r, 13).Value = TTax
Cells(r, 14).Value = Rent
Cells(r, 15).Value = Pet
Cells(r, 16).Value = Cleaning
Cells(r, 17).Value = HotTub
Cells(r, 18).Value = CheckIn
Cells(r, 19).Value = CheckOut
Cells(r, 20).Value = NIGHTS
Cells(r, 21).Value = Origin
Cells(r, 22).Value = Lead
End If ' 1. If SheetExistsFDB(RealPath, "Contract") = True
Next i
Sub WriteFormulasvalues(iFilePath As String, iFilename As String, iSheet As String, iRC As String, iRange As Range, Optional AdditionalText As String)
myFormula = "='" & iFilePath & "[" & iFilename & "]" & iSheet & "'!" & iRC & ""
With iRange
.Formula = myFormula
.Value = AdditionalText & .Value
End With
End Sub