我目前正在創建一個宏，它應該能夠讀取一組如下圖所示的資料，并根據帳號的前 3 位數字創建新作業表。
例如：
BKAsheet 將擁有所有 BKA 帳戶 - 然后將創建一個包含所有 BPA 帳戶的新作業表，依此類推
但是，當我運行我擁有的代碼時，程式會創建 1 張紙并在那里停止，然后回傳應用程式/物件定義的錯誤“錯誤 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
請參閱以下鏈接到我的作業簿。
uj5u.com熱心網友回復：
沒有看到實際檔案很難知道，但是我猜這與作業表名稱有關，因此如果您只是將作業表名稱更改為其他變數，則在回圈中，只是為了除錯它是否在這種情況下作業。如果您上傳檔案，幾乎不需要 1 分鐘就可以理解。
干杯
您正在使用靜態變數 randNumber，您需要將這一行放在下面的 while 回圈之后，因此每次更改數字時，因為 excel 不能有同名的作業表。
While Left(mainWS.Cells(mainR, 1), 3) = accHolder
randNumber = Int((99999 - 10000 1) * Rnd 10000) ' this one
mainWB.Sheets.Add.Name = accHolder & "-" & randNumber
uj5u.com熱心網友回復：
我試圖在代碼中包含注釋以解釋它在必要時做什么，請閱讀它，如果您不理解任何內容，請隨時詢問。
需要注意的幾個要點：
由于您在同一作業簿中運行代碼，因此您無需設定作業簿變數（
mainWB在您的問題中），因為您可以簡單地將其稱為ThisWorkbook.作為參考，請閱讀有關如何查找最后一行/列的答案。
逐個單元讀取/寫入值是一個非常昂貴的程序，因此建議先將資料寫入陣列，然后將陣列資料插入作業表一次，因為這樣會快得多。
試試下面的代碼：
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
注意：即使您已經鏈接了它，我也沒有在您的檔案上對其進行測驗。
轉載請註明出處，本文鏈接：https://www.uj5u.com/net/324378.html