While 语句返回应用程序/对象定义的错误 "Error 1004"
While statement returning Application / Object defined error "Error 1004"
我目前正在创建一个宏，它应该能够读取一组如下图所示的数据，并根据帐号的前 3 位数字创建新的 sheets。
例如：
BKAsheet 将拥有所有 BKA 帐户 - 然后将创建一个包含所有 BPA 帐户的新 sheet，依此类推
但是，当我 运行 我拥有的代码时，程序创建 1 sheet 并停在那里，然后 returns 应用程序/对象定义错误“错误 1004”
请查看以下代码，了解问题出在哪里
Option Explicit
Public mainWB As Workbook
Public mainWS As Worksheet
Public newWS As Worksheet
Sub Main()
'Creating New Variables
Dim TranstactDate As Date, AmountExcl As Double, Account As String
Dim mainR As Long, mainC As Long, newR As Long, newC As Long
Dim randNumber As Long
Dim accHolder As String
Dim path As String
newR = 2 'start of writing Row
path = ThisWorkbook.path
Set mainWB = Workbooks("arrears-formatter.xlsx") 'Setting mainWB
Set mainWS = mainWB.Worksheets("arrears-formatter") ' set mainWS to the working Worksheet
mainWB.Activate 'Shows that were working in the mainWB workbook
randNumber = Int((99999 - 10000 + 1) * Rnd + 10000) ' Generating a random number
TranstactDate = mainWS.Cells(1, 2) ' Set TransDate to the date that the user enters
For mainR = 9 To 100000 ' For all the rows in the mainWS
If mainWS.Cells(mainR, 1) = "" Then GoTo exitthis: ' If the account col is blank , exitthis :
accHolder = Left(mainWS.Cells(mainR, 1), 3) ' Defining the account letters (E.G. GLA)
AmountExcl = mainWS.Cells(mainR, 3) ' Defining the interest included amount to print
Account = mainWS.Cells(mainR, 1) 'Defining the full account number
While Left(mainWS.Cells(mainR, 1), 3) = accHolder ' While the left of mainR 1 = the left of mainR 1 do
mainWB.Sheets.Add.Name = accHolder & "-" & randNumber ' Adding a sheet
Set newWS = mainWB.Worksheets(accHolder & "-" & randNumber) 'Setting the Sheet
'Determining new sheet values
newWS.Cells(newR, 1) = mainWS.Cells(1, 2)
newWS.Cells(newR, 2) = Account
newWS.Cells(newR, 3) = "AR"
newWS.Cells(newR, 4) = "Interest"
newWS.Cells(newR, 5) = "0"
newWS.Cells(newR, 6) = "7"
newWS.Cells(newR, 7) = "Interest"
newWS.Cells(newR, 8) = ""
newWS.Cells(newR, 9) = AmountExcl
newWS.Cells(newR, 10) = ""
newWS.Cells(newR, 11) = ""
newWS.Cells(newR, 12) = "0"
newWS.Cells(newR, 13) = AmountExcl
newWS.Cells(newR, 14) = "1"
newWS.Cells(newR, 15) = AmountExcl
newWS.Cells(newR, 16) = AmountExcl
newWS.Cells(newR, 17) = "0"
newWS.Cells(newR, 18) = "0"
newWS.Cells(newR, 19) = ""
newWS.Cells(newR, 20) = "0"
newWS.Cells(newR, 21) = "0"
newWS.Cells(newR, 22) = "0"
newWS.Cells(newR, 23) = ""
newWS.Cells(newR, 24) = ""
newWS.Cells(newR, 25) = "0"
newWS.Cells(newR, 26) = "0"
newWS.Cells(newR, 27) = ""
newWS.Cells(newR, 28) = "0"
newWS.Cells(newR, 29) = "0"
newWS.Cells(newR, 30) = "0"
newWS.Cells(newR, 31) = "2750>050"
newWS.Cells(newR, 32) = "0"
newWS.Cells(newR, 33) = "0"
newR = newR + 1 'Increasing new sheet row
If Left(mainWS.Cells(mainR, 1), 3) <> accHolder Then GoTo exitthis: ' If the Account name is not the same , skip to the end of the loop
Wend
exitthis:
Next mainR
End Sub
请参阅下面link我的作业本。
如果没有看到实际的文件很难知道，但我猜这与 sheet 名称有关，所以在一个循环中，如果你只是将 sheet 名称更改为其他名称变量，只是为了调试它是否在这种情况下工作。
如果你上传文件，几乎不需要 1 分钟就可以理解。
干杯
您使用的是静态变量 randNumber，您需要将这一行放在 while 循环之后，就像我在下面所说的那样，所以每次更改数字时，因为 excel 无法使用相同的 sheet名字.
While Left(mainWS.Cells(mainR, 1), 3) = accHolder
randNumber = Int((99999 - 10000 + 1) * Rnd + 10000) ' this one
mainWB.Sheets.Add.Name = accHolder & "-" & randNumber
我已尝试在代码中包含注释以在必要时解释它的作用，请阅读它，如果您不理解其中的任何内容，请随时询问。
需要注意的几个要点：
由于您是 运行 同一工作簿中的代码，因此无需设置工作簿变量（在您的问题中为 mainWB），您可以简单地将其称为 ThisWorkbook.
作为参考，请阅读此 如何找到最后一个 row/column。
Reading/Writing 逐个单元格的值是一个非常昂贵的过程，因此建议先将数据写入数组，然后将数组数据插入工作表一次，因为它很多快多了。
试试下面的代码：
Option Explicit
Public mainWS As Worksheet
Public newWS As Worksheet
Sub Main()
'Creating New Variables
Dim TranstactDate As Date, AmountExcl As Double, Account As String
Dim mainR As Long
Dim randNumber As Long
Dim accHolder As String
Set mainWS = ThisWorkbook.Worksheets("arrears-formatter") ' set mainWS to the working Worksheet
randNumber = Int((99999 - 10000 + 1) * Rnd + 10000) ' Generating a random number
TranstactDate = mainWS.Cells(1, 2) ' Set TransDate to the date that the user enters
'Retrieve the last row in column A.
Dim lastRow As Long
lastRow = mainWS.Cells(mainWS.Rows.Count, 1).End(xlUp).Row
'===========
'Creates an array to store the static data, the commented out lines are either for dynamic data to be assigned later on or not needed since it's empty
'The array will be used to populate the 33 columns of data at once which is faster than assigning the value cell-by-cell
Dim inputArr(1 To 1, 1 To 33) As Variant
inputArr(1, 1) = TranstactDate
'inputArr(1, 2) = Account
inputArr(1, 3) = "AR"
inputArr(1, 4) = "Interest"
inputArr(1, 5) = "0"
inputArr(1, 6) = "7"
inputArr(1, 7) = "Interest"
'inputArr(1, 8) = ""
'inputArr(1, 9) = AmountExcl
'inputArr(1, 10) = ""
'inputArr(1, 11) = ""
inputArr(1, 12) = "0"
'inputArr(1, 13) = AmountExcl
inputArr(1, 14) = "1"
'inputArr(1, 15) = AmountExcl
'inputArr(1, 16) = AmountExcl
inputArr(1, 17) = "0"
inputArr(1, 18) = "0"
'inputArr(1, 19) = ""
inputArr(1, 20) = "0"
inputArr(1, 21) = "0"
inputArr(1, 22) = "0"
'inputArr(1, 23) = ""
'inputArr(1, 24) = ""
inputArr(1, 25) = "0"
inputArr(1, 26) = "0"
'inputArr(1, 27) = ""
inputArr(1, 28) = "0"
inputArr(1, 29) = "0"
inputArr(1, 30) = "0"
inputArr(1, 31) = "2750>050"
inputArr(1, 32) = "0"
inputArr(1, 33) = "0"
'===========
For mainR = 9 To lastRow ' For all the rows in the mainWS
accHolder = Left(mainWS.Cells(mainR, 1), 3) ' Defining the account letters (E.G. GLA)
AmountExcl = mainWS.Cells(mainR, 3) ' Defining the interest included amount to print
Account = mainWS.Cells(mainR, 1) 'Defining the full account number
'===========
'This portion will attempt to set newWS to the intended worksheet
'If the worksheet does not exist, it will generate an error which is then captured in the If statement and handled by creating a new worksheet of the name and assign newWS to it
On Error Resume Next
Set newWS = ThisWorkbook.Worksheets(accHolder & "-" & randNumber)
If Err.Number <> 0 Then
Err.Clear
Set newWS = ThisWorkbook.Worksheets.Add
newWS.Name = accHolder & "-" & randNumber
End If
On Error GoTo 0
'===========
'Assigning the dynamic data to the array created previously
inputArr(1, 2) = Account
inputArr(1, 9) = AmountExcl
inputArr(1, 13) = AmountExcl
inputArr(1, 15) = AmountExcl
inputArr(1, 16) = AmountExcl
'Find the last empty row in newWS
Dim newWSInsertRow As Long
newWSInsertRow = newWS.Cells(newWS.Rows.Count, 1).End(xlUp).Row + 1
'Insert the array data into the last empty row
newWS.Cells(newWSInsertRow, 1).Resize(, 33).Value = inputArr
Next mainR
End Sub
注意：我没有在你的文件上测试它，即使你已经链接了它。
我目前正在创建一个宏，它应该能够读取一组如下图所示的数据，并根据帐号的前 3 位数字创建新的 sheets。
例如：
BKAsheet 将拥有所有 BKA 帐户 - 然后将创建一个包含所有 BPA 帐户的新 sheet，依此类推
但是，当我 运行 我拥有的代码时，程序创建 1 sheet 并停在那里，然后 returns 应用程序/对象定义错误“错误 1004”
请查看以下代码，了解问题出在哪里
Option Explicit
Public mainWB As Workbook
Public mainWS As Worksheet
Public newWS As Worksheet
Sub Main()
'Creating New Variables
Dim TranstactDate As Date, AmountExcl As Double, Account As String
Dim mainR As Long, mainC As Long, newR As Long, newC As Long
Dim randNumber As Long
Dim accHolder As String
Dim path As String
newR = 2 'start of writing Row
path = ThisWorkbook.path
Set mainWB = Workbooks("arrears-formatter.xlsx") 'Setting mainWB
Set mainWS = mainWB.Worksheets("arrears-formatter") ' set mainWS to the working Worksheet
mainWB.Activate 'Shows that were working in the mainWB workbook
randNumber = Int((99999 - 10000 + 1) * Rnd + 10000) ' Generating a random number
TranstactDate = mainWS.Cells(1, 2) ' Set TransDate to the date that the user enters
For mainR = 9 To 100000 ' For all the rows in the mainWS
If mainWS.Cells(mainR, 1) = "" Then GoTo exitthis: ' If the account col is blank , exitthis :
accHolder = Left(mainWS.Cells(mainR, 1), 3) ' Defining the account letters (E.G. GLA)
AmountExcl = mainWS.Cells(mainR, 3) ' Defining the interest included amount to print
Account = mainWS.Cells(mainR, 1) 'Defining the full account number
While Left(mainWS.Cells(mainR, 1), 3) = accHolder ' While the left of mainR 1 = the left of mainR 1 do
mainWB.Sheets.Add.Name = accHolder & "-" & randNumber ' Adding a sheet
Set newWS = mainWB.Worksheets(accHolder & "-" & randNumber) 'Setting the Sheet
'Determining new sheet values
newWS.Cells(newR, 1) = mainWS.Cells(1, 2)
newWS.Cells(newR, 2) = Account
newWS.Cells(newR, 3) = "AR"
newWS.Cells(newR, 4) = "Interest"
newWS.Cells(newR, 5) = "0"
newWS.Cells(newR, 6) = "7"
newWS.Cells(newR, 7) = "Interest"
newWS.Cells(newR, 8) = ""
newWS.Cells(newR, 9) = AmountExcl
newWS.Cells(newR, 10) = ""
newWS.Cells(newR, 11) = ""
newWS.Cells(newR, 12) = "0"
newWS.Cells(newR, 13) = AmountExcl
newWS.Cells(newR, 14) = "1"
newWS.Cells(newR, 15) = AmountExcl
newWS.Cells(newR, 16) = AmountExcl
newWS.Cells(newR, 17) = "0"
newWS.Cells(newR, 18) = "0"
newWS.Cells(newR, 19) = ""
newWS.Cells(newR, 20) = "0"
newWS.Cells(newR, 21) = "0"
newWS.Cells(newR, 22) = "0"
newWS.Cells(newR, 23) = ""
newWS.Cells(newR, 24) = ""
newWS.Cells(newR, 25) = "0"
newWS.Cells(newR, 26) = "0"
newWS.Cells(newR, 27) = ""
newWS.Cells(newR, 28) = "0"
newWS.Cells(newR, 29) = "0"
newWS.Cells(newR, 30) = "0"
newWS.Cells(newR, 31) = "2750>050"
newWS.Cells(newR, 32) = "0"
newWS.Cells(newR, 33) = "0"
newR = newR + 1 'Increasing new sheet row
If Left(mainWS.Cells(mainR, 1), 3) <> accHolder Then GoTo exitthis: ' If the Account name is not the same , skip to the end of the loop
Wend
exitthis:
Next mainR
End Sub
请参阅下面link我的作业本。
如果没有看到实际的文件很难知道，但我猜这与 sheet 名称有关，所以在一个循环中，如果你只是将 sheet 名称更改为其他名称变量，只是为了调试它是否在这种情况下工作。 如果你上传文件，几乎不需要 1 分钟就可以理解。
干杯
您使用的是静态变量 randNumber，您需要将这一行放在 while 循环之后，就像我在下面所说的那样，所以每次更改数字时，因为 excel 无法使用相同的 sheet名字.
While Left(mainWS.Cells(mainR, 1), 3) = accHolder
randNumber = Int((99999 - 10000 + 1) * Rnd + 10000) ' this one
mainWB.Sheets.Add.Name = accHolder & "-" & randNumber
我已尝试在代码中包含注释以在必要时解释它的作用，请阅读它，如果您不理解其中的任何内容，请随时询问。
需要注意的几个要点：
由于您是 运行 同一工作簿中的代码，因此无需设置工作簿变量（在您的问题中为
mainWB），您可以简单地将其称为ThisWorkbook.作为参考，请阅读此
Reading/Writing 逐个单元格的值是一个非常昂贵的过程，因此建议先将数据写入数组，然后将数组数据插入工作表一次，因为它很多快多了。
试试下面的代码：
Option Explicit
Public mainWS As Worksheet
Public newWS As Worksheet
Sub Main()
'Creating New Variables
Dim TranstactDate As Date, AmountExcl As Double, Account As String
Dim mainR As Long
Dim randNumber As Long
Dim accHolder As String
Set mainWS = ThisWorkbook.Worksheets("arrears-formatter") ' set mainWS to the working Worksheet
randNumber = Int((99999 - 10000 + 1) * Rnd + 10000) ' Generating a random number
TranstactDate = mainWS.Cells(1, 2) ' Set TransDate to the date that the user enters
'Retrieve the last row in column A.
Dim lastRow As Long
lastRow = mainWS.Cells(mainWS.Rows.Count, 1).End(xlUp).Row
'===========
'Creates an array to store the static data, the commented out lines are either for dynamic data to be assigned later on or not needed since it's empty
'The array will be used to populate the 33 columns of data at once which is faster than assigning the value cell-by-cell
Dim inputArr(1 To 1, 1 To 33) As Variant
inputArr(1, 1) = TranstactDate
'inputArr(1, 2) = Account
inputArr(1, 3) = "AR"
inputArr(1, 4) = "Interest"
inputArr(1, 5) = "0"
inputArr(1, 6) = "7"
inputArr(1, 7) = "Interest"
'inputArr(1, 8) = ""
'inputArr(1, 9) = AmountExcl
'inputArr(1, 10) = ""
'inputArr(1, 11) = ""
inputArr(1, 12) = "0"
'inputArr(1, 13) = AmountExcl
inputArr(1, 14) = "1"
'inputArr(1, 15) = AmountExcl
'inputArr(1, 16) = AmountExcl
inputArr(1, 17) = "0"
inputArr(1, 18) = "0"
'inputArr(1, 19) = ""
inputArr(1, 20) = "0"
inputArr(1, 21) = "0"
inputArr(1, 22) = "0"
'inputArr(1, 23) = ""
'inputArr(1, 24) = ""
inputArr(1, 25) = "0"
inputArr(1, 26) = "0"
'inputArr(1, 27) = ""
inputArr(1, 28) = "0"
inputArr(1, 29) = "0"
inputArr(1, 30) = "0"
inputArr(1, 31) = "2750>050"
inputArr(1, 32) = "0"
inputArr(1, 33) = "0"
'===========
For mainR = 9 To lastRow ' For all the rows in the mainWS
accHolder = Left(mainWS.Cells(mainR, 1), 3) ' Defining the account letters (E.G. GLA)
AmountExcl = mainWS.Cells(mainR, 3) ' Defining the interest included amount to print
Account = mainWS.Cells(mainR, 1) 'Defining the full account number
'===========
'This portion will attempt to set newWS to the intended worksheet
'If the worksheet does not exist, it will generate an error which is then captured in the If statement and handled by creating a new worksheet of the name and assign newWS to it
On Error Resume Next
Set newWS = ThisWorkbook.Worksheets(accHolder & "-" & randNumber)
If Err.Number <> 0 Then
Err.Clear
Set newWS = ThisWorkbook.Worksheets.Add
newWS.Name = accHolder & "-" & randNumber
End If
On Error GoTo 0
'===========
'Assigning the dynamic data to the array created previously
inputArr(1, 2) = Account
inputArr(1, 9) = AmountExcl
inputArr(1, 13) = AmountExcl
inputArr(1, 15) = AmountExcl
inputArr(1, 16) = AmountExcl
'Find the last empty row in newWS
Dim newWSInsertRow As Long
newWSInsertRow = newWS.Cells(newWS.Rows.Count, 1).End(xlUp).Row + 1
'Insert the array data into the last empty row
newWS.Cells(newWSInsertRow, 1).Resize(, 33).Value = inputArr
Next mainR
End Sub
注意：我没有在你的文件上测试它，即使你已经链接了它。