为什么这个 Excel 2007 VBA 程序无法 iterate/reassign 一个 Range 变量？
Why does this Excel 2007 VBA program fail to iterate/reassign a Range variable?
根据建议从超级详细的历史记录模式中删除。
我的专业水平：十年前破解了一些相当复杂的对话框多工作簿宏系统，经验丰富但没有经过正式培训并且生疏。
这个宏中的复杂内容有效；它的主要错误是它不会更改 CurrentClientAnchor Range 变量，这是 Excel VBA 中最基本的操作，无论我做什么。它在单元格 A2 上循环任意次数，正确找到下一个应该成为 CurrentClientAnchor 的单元格（在实际数据上，A4，向下两个单元格），并根据所选数据完美地创建发票 sheet只要您允许它覆盖它刚刚在一秒钟前创建的副本。如果我的特殊最后记录例程破坏了某些东西，我不会感到惊讶，而是手动单步执行，该 If 子句的 none 曾经运行过。程序正确地跳过了它。 WhatsMyAnchor 应该在最后一个循环命令之前为 4，但永远不会从 2 改变。
我知道的实现我想要的但代码中没有留下注释化石的唯一方法是我编写的第一个方法，将 ClientsRange 分配为 Range over Range("A2", Cells( LastRow,1)) 然后将所有内容放入 For...Next 循环中。该版本也只是 运行 在第一条记录上一遍又一遍。
请问我在哪方面非常愚蠢？
Option Explicit
Sub FillOutInvoices()
Dim BilledDate As String
Dim ServiceYear As String
Dim ServiceMonth As String
Dim CompBasePath As String
Dim InvoiceTemplatePath As String
InvoiceTemplatePath = "H:\Comp\Comp Invoice BLANK PRINT COPY.xls"
'The info to change for each invoicing
'========================
'========================
CompBasePath = "H:\Comp14 Invoices\"
ServiceYear = "2014"
ServiceMonth = "September"
BilledDate = "02/01/2015"
'========================
'========================
Dim InvoiceFolder As String
InvoiceFolder = CompBasePath & ServiceYear & " " & ServiceMonth & " generated invoices" & "\"
If Dir(InvoiceFolder, vbDirectory) = vbNullString Then
MkDir InvoiceFolder
End If
'Find the last used row on the sheet with a web recipe to speed things up
'and avoid arbitrary search windows.
Dim LastRow As Long
LastRow = ActiveSheet.UsedRange.Rows.Count
'We assume our first client is in A2
Dim CurrentClientAnchor As Range
Set CurrentClientAnchor = Range("A2")
Dim DataHeight As Single
Dim NoMoreRecords As Boolean
NoMoreRecords = False
'Debugging variable so I don't have to paw through
'a zillion properties of CCA in the Watch pane all the time
Dim WhatsMyAnchor As Single
WhatsMyAnchor = CurrentClientAnchor.Row
Do Until NoMoreRecords = True 'Loop captures falling through the last record, internal exit catches
'the next result each time
'Surprisingly the main loop. For each client, find the next one or end of job,
'use that as an upper and lower bound to create and write the invoice
'Transplanted inline from what should be a sub, because I need it to Just Work Now.
'As a sub, causes Object Required error on passing the range which is a range into the range slot that's designated as a range.
'This should become some clever run-once array of nonempty ranges someday
'Find next nonempty A. If none before lastrow, last record; find last nonempty F, set rows, copy data, terminate macro.
'If found, set rows and copy data
DataHeight = 1
Do Until CurrentClientAnchor.Offset(DataHeight, 0).Value <> ""
'Find the next nonempty cell below CurrentClientAnchor and record the offset
'We're falling off the bottom of the last one, have to do our special last search up front here.
If CurrentClientAnchor.Offset(DataHeight, 0).Row = LastRow Then 'special finder for last record down F to first empty cell
NoMoreRecords = True
DataHeight = 1
Do Until CurrentClientAnchor.Offset(DataHeight, 5).Value = ""
DataHeight = DataHeight + 1
Loop
Exit Do
End If
DataHeight = DataHeight + 1
Loop
'We now have our DataHeight value for the grunt work.
'Subtract one from it, to convert to the cell offsets we'll use
DataHeight = DataHeight - 1
'Inlined from sub again because I apparently don't know how to pass a variable.
'MakeInvoiceFile
Dim SourceBook As Workbook
Set SourceBook = ThisWorkbook
Dim InvoiceFileName As String
InvoiceFileName = InvoiceFolder & _
CurrentClientAnchor.Value & " " & ServiceYear & " " & ServiceMonth & " Invoice" & ".xls"
Dim DestBook As Workbook
Dim Template As Workbook
Application.Workbooks.Open InvoiceTemplatePath
Set Template = ActiveWorkbook
Set DestBook = ActiveWorkbook
DestBook.SaveAs (InvoiceFileName)
SourceBook.Activate
'Close for debugging cleanliness, more elegant keep open behavior later
'Doesn't work. Maybe not even ugly, anyway cut for dev time.
'Template.Close
'More debugging watchable variables
Dim WhereCopyingRow As Single
Dim WhereCopyingColumn As Single
Dim CopyRange As Range
'Client name into job name
Set CopyRange = CurrentClientAnchor
WhereCopyingRow = CopyRange.Row
WhereCopyingColumn = CopyRange.Column
CopyRange.Copy
DestBook.Sheets(1).Cells(3, 4).PasteSpecial xlPasteValues, xlPasteSpecialOperationNone
'Service address into job location
Set CopyRange = CurrentClientAnchor.Offset(0, 3)
WhereCopyingRow = CopyRange.Row
WhereCopyingColumn = CopyRange.Column
CopyRange.Copy
DestBook.Sheets(1).Cells(4, 4).PasteSpecial xlPasteValues, xlPasteSpecialOperationNone
'Billing address into billing address
Set CopyRange = CurrentClientAnchor.Offset(0, 4)
WhereCopyingRow = CopyRange.Row
WhereCopyingColumn = CopyRange.Column
CopyRange.Copy
DestBook.Sheets(1).Cells(9, 2).PasteSpecial xlPasteValues, xlPasteSpecialOperationNone
'Billing Date into Date Billed
'Currently discarded for progress
'DestBook.Sheets(1).Cells(24, 3).PasteSpecial xlPasteValues, xlPasteSpecialOperationNone
'Descriptions
Set CopyRange = Range(CurrentClientAnchor.Offset(0, 5), CurrentClientAnchor.Offset(DataHeight, 5))
WhereCopyingRow = CopyRange.Row
WhereCopyingColumn = CopyRange.Column
CopyRange.Copy
DestBook.Sheets(1).Cells(13, 2).PasteSpecial xlPasteValues, xlPasteSpecialOperationNone
'Totals
Set CopyRange = Range(CurrentClientAnchor.Offset(0, 14), CurrentClientAnchor.Offset(DataHeight, 15))
WhereCopyingRow = CopyRange.Row
WhereCopyingColumn = CopyRange.Column
CopyRange.Copy
DestBook.Sheets(1).Cells(13, 6).PasteSpecial xlPasteValues, xlPasteSpecialOperationNone
'Overall total
Set CopyRange = CurrentClientAnchor.Offset(DataHeight, 16)
WhereCopyingRow = CopyRange.Row
WhereCopyingColumn = CopyRange.Column
CopyRange.Copy
DestBook.Sheets(1).Cells(24, 6).PasteSpecial xlPasteValues, xlPasteSpecialOperationNone
DestBook.Save
DestBook.Close
'SourceBook appears to be activated when we close DestBook, but it's failing to iterate so let's make sure.
SourceBook.Activate
'CurrentClientAnchor = CurrentClientAnchor.Offset(DataHeight + 1, 0)
'WhatsMyAnchor = CurrentClientAnchor.Row
'Apparently we can't assign a range to its offset, fails to iterate, so
'we pop out to selection and back to the variable.
'CurrentClientAnchor.Offset(DataHeight + 1, 0).Select
'CurrentClientAnchor = Selection
'WhatsMyAnchor = CurrentClientAnchor.Row
'Nope. Escalate to activating and assigning.
'CurrentClientAnchor.Offset(DataHeight + 1, 0).Activate
'CurrentClientAnchor = ActiveCell
'WhatsMyAnchor = CurrentClientAnchor.Row
'That doesn't iterate either, it's really hard for a programming language in
'Excel to iterate on the most common object in Excel,
'so let's turn the blasted stupid debugging variable into an absolute cell selector
Set CurrentClientAnchor = ActiveSheet.Cells(WhatsMyAnchor + DataHeight + 1, 0)
WhatsMyAnchor = CurrentClientAnchor.Row
'That throws a 1004 error with or without the Set, "application or object-defined error", thanks.
'It's just impossible to move a Range down a few cells. Excel VBA can't do that. You can't vary a Range variable.
Loop
MsgBox "All successfully written"
End Sub
一个相对较小的问题写了很多，我建议在以后的问题中删掉所有不必要的文字；很多人只会看到大量的文字并继续前进。
关于您的问题，我认为稍作改动即可：
如果您只在前面添加 Set，您注释掉的示例应该有效：
Set CurrentClientAnchor = CurrentClientAnchor.Offset(DataHeight + 1, 0)
正如你在
行中看到的那样
Set CurrentClientAnchor = ActiveSheet.Cells(WhatsMyAnchor + DataHeight + 1, 0)
改为
Set CurrentClientAnchor = ActiveSheet.Range("A" & WhatsMyAnchor + DataHeight + 1)
应该也可以。
根据建议从超级详细的历史记录模式中删除。
我的专业水平：十年前破解了一些相当复杂的对话框多工作簿宏系统，经验丰富但没有经过正式培训并且生疏。
这个宏中的复杂内容有效；它的主要错误是它不会更改 CurrentClientAnchor Range 变量，这是 Excel VBA 中最基本的操作，无论我做什么。它在单元格 A2 上循环任意次数，正确找到下一个应该成为 CurrentClientAnchor 的单元格（在实际数据上，A4，向下两个单元格），并根据所选数据完美地创建发票 sheet只要您允许它覆盖它刚刚在一秒钟前创建的副本。如果我的特殊最后记录例程破坏了某些东西，我不会感到惊讶，而是手动单步执行，该 If 子句的 none 曾经运行过。程序正确地跳过了它。 WhatsMyAnchor 应该在最后一个循环命令之前为 4，但永远不会从 2 改变。
我知道的实现我想要的但代码中没有留下注释化石的唯一方法是我编写的第一个方法，将 ClientsRange 分配为 Range over Range("A2", Cells( LastRow,1)) 然后将所有内容放入 For...Next 循环中。该版本也只是 运行 在第一条记录上一遍又一遍。
请问我在哪方面非常愚蠢？
Option Explicit
Sub FillOutInvoices()
Dim BilledDate As String
Dim ServiceYear As String
Dim ServiceMonth As String
Dim CompBasePath As String
Dim InvoiceTemplatePath As String
InvoiceTemplatePath = "H:\Comp\Comp Invoice BLANK PRINT COPY.xls"
'The info to change for each invoicing
'========================
'========================
CompBasePath = "H:\Comp14 Invoices\"
ServiceYear = "2014"
ServiceMonth = "September"
BilledDate = "02/01/2015"
'========================
'========================
Dim InvoiceFolder As String
InvoiceFolder = CompBasePath & ServiceYear & " " & ServiceMonth & " generated invoices" & "\"
If Dir(InvoiceFolder, vbDirectory) = vbNullString Then
MkDir InvoiceFolder
End If
'Find the last used row on the sheet with a web recipe to speed things up
'and avoid arbitrary search windows.
Dim LastRow As Long
LastRow = ActiveSheet.UsedRange.Rows.Count
'We assume our first client is in A2
Dim CurrentClientAnchor As Range
Set CurrentClientAnchor = Range("A2")
Dim DataHeight As Single
Dim NoMoreRecords As Boolean
NoMoreRecords = False
'Debugging variable so I don't have to paw through
'a zillion properties of CCA in the Watch pane all the time
Dim WhatsMyAnchor As Single
WhatsMyAnchor = CurrentClientAnchor.Row
Do Until NoMoreRecords = True 'Loop captures falling through the last record, internal exit catches
'the next result each time
'Surprisingly the main loop. For each client, find the next one or end of job,
'use that as an upper and lower bound to create and write the invoice
'Transplanted inline from what should be a sub, because I need it to Just Work Now.
'As a sub, causes Object Required error on passing the range which is a range into the range slot that's designated as a range.
'This should become some clever run-once array of nonempty ranges someday
'Find next nonempty A. If none before lastrow, last record; find last nonempty F, set rows, copy data, terminate macro.
'If found, set rows and copy data
DataHeight = 1
Do Until CurrentClientAnchor.Offset(DataHeight, 0).Value <> ""
'Find the next nonempty cell below CurrentClientAnchor and record the offset
'We're falling off the bottom of the last one, have to do our special last search up front here.
If CurrentClientAnchor.Offset(DataHeight, 0).Row = LastRow Then 'special finder for last record down F to first empty cell
NoMoreRecords = True
DataHeight = 1
Do Until CurrentClientAnchor.Offset(DataHeight, 5).Value = ""
DataHeight = DataHeight + 1
Loop
Exit Do
End If
DataHeight = DataHeight + 1
Loop
'We now have our DataHeight value for the grunt work.
'Subtract one from it, to convert to the cell offsets we'll use
DataHeight = DataHeight - 1
'Inlined from sub again because I apparently don't know how to pass a variable.
'MakeInvoiceFile
Dim SourceBook As Workbook
Set SourceBook = ThisWorkbook
Dim InvoiceFileName As String
InvoiceFileName = InvoiceFolder & _
CurrentClientAnchor.Value & " " & ServiceYear & " " & ServiceMonth & " Invoice" & ".xls"
Dim DestBook As Workbook
Dim Template As Workbook
Application.Workbooks.Open InvoiceTemplatePath
Set Template = ActiveWorkbook
Set DestBook = ActiveWorkbook
DestBook.SaveAs (InvoiceFileName)
SourceBook.Activate
'Close for debugging cleanliness, more elegant keep open behavior later
'Doesn't work. Maybe not even ugly, anyway cut for dev time.
'Template.Close
'More debugging watchable variables
Dim WhereCopyingRow As Single
Dim WhereCopyingColumn As Single
Dim CopyRange As Range
'Client name into job name
Set CopyRange = CurrentClientAnchor
WhereCopyingRow = CopyRange.Row
WhereCopyingColumn = CopyRange.Column
CopyRange.Copy
DestBook.Sheets(1).Cells(3, 4).PasteSpecial xlPasteValues, xlPasteSpecialOperationNone
'Service address into job location
Set CopyRange = CurrentClientAnchor.Offset(0, 3)
WhereCopyingRow = CopyRange.Row
WhereCopyingColumn = CopyRange.Column
CopyRange.Copy
DestBook.Sheets(1).Cells(4, 4).PasteSpecial xlPasteValues, xlPasteSpecialOperationNone
'Billing address into billing address
Set CopyRange = CurrentClientAnchor.Offset(0, 4)
WhereCopyingRow = CopyRange.Row
WhereCopyingColumn = CopyRange.Column
CopyRange.Copy
DestBook.Sheets(1).Cells(9, 2).PasteSpecial xlPasteValues, xlPasteSpecialOperationNone
'Billing Date into Date Billed
'Currently discarded for progress
'DestBook.Sheets(1).Cells(24, 3).PasteSpecial xlPasteValues, xlPasteSpecialOperationNone
'Descriptions
Set CopyRange = Range(CurrentClientAnchor.Offset(0, 5), CurrentClientAnchor.Offset(DataHeight, 5))
WhereCopyingRow = CopyRange.Row
WhereCopyingColumn = CopyRange.Column
CopyRange.Copy
DestBook.Sheets(1).Cells(13, 2).PasteSpecial xlPasteValues, xlPasteSpecialOperationNone
'Totals
Set CopyRange = Range(CurrentClientAnchor.Offset(0, 14), CurrentClientAnchor.Offset(DataHeight, 15))
WhereCopyingRow = CopyRange.Row
WhereCopyingColumn = CopyRange.Column
CopyRange.Copy
DestBook.Sheets(1).Cells(13, 6).PasteSpecial xlPasteValues, xlPasteSpecialOperationNone
'Overall total
Set CopyRange = CurrentClientAnchor.Offset(DataHeight, 16)
WhereCopyingRow = CopyRange.Row
WhereCopyingColumn = CopyRange.Column
CopyRange.Copy
DestBook.Sheets(1).Cells(24, 6).PasteSpecial xlPasteValues, xlPasteSpecialOperationNone
DestBook.Save
DestBook.Close
'SourceBook appears to be activated when we close DestBook, but it's failing to iterate so let's make sure.
SourceBook.Activate
'CurrentClientAnchor = CurrentClientAnchor.Offset(DataHeight + 1, 0)
'WhatsMyAnchor = CurrentClientAnchor.Row
'Apparently we can't assign a range to its offset, fails to iterate, so
'we pop out to selection and back to the variable.
'CurrentClientAnchor.Offset(DataHeight + 1, 0).Select
'CurrentClientAnchor = Selection
'WhatsMyAnchor = CurrentClientAnchor.Row
'Nope. Escalate to activating and assigning.
'CurrentClientAnchor.Offset(DataHeight + 1, 0).Activate
'CurrentClientAnchor = ActiveCell
'WhatsMyAnchor = CurrentClientAnchor.Row
'That doesn't iterate either, it's really hard for a programming language in
'Excel to iterate on the most common object in Excel,
'so let's turn the blasted stupid debugging variable into an absolute cell selector
Set CurrentClientAnchor = ActiveSheet.Cells(WhatsMyAnchor + DataHeight + 1, 0)
WhatsMyAnchor = CurrentClientAnchor.Row
'That throws a 1004 error with or without the Set, "application or object-defined error", thanks.
'It's just impossible to move a Range down a few cells. Excel VBA can't do that. You can't vary a Range variable.
Loop
MsgBox "All successfully written"
End Sub
一个相对较小的问题写了很多，我建议在以后的问题中删掉所有不必要的文字；很多人只会看到大量的文字并继续前进。
关于您的问题，我认为稍作改动即可：
如果您只在前面添加 Set，您注释掉的示例应该有效：
Set CurrentClientAnchor = CurrentClientAnchor.Offset(DataHeight + 1, 0)
正如你在
行中看到的那样Set CurrentClientAnchor = ActiveSheet.Cells(WhatsMyAnchor + DataHeight + 1, 0)
改为
Set CurrentClientAnchor = ActiveSheet.Range("A" & WhatsMyAnchor + DataHeight + 1)
应该也可以。