VBA Excel:错误代码438对象不存在';我的VBA代码中不支持此属性
我是VBA的新手。当count=10000时,我为分割文件编写了一个代码,当数据不是整数时,在单元格中移动单独的数据。然后,我被告知对象不支持此属性或方法。如果有人知道为什么会发生这种情况,我想得到一些帮助。谢谢VBA Excel:错误代码438对象不存在';我的VBA代码中不支持此属性,excel,excel-2016,Excel,Excel 2016,我是VBA的新手。当count=10000时,我为分割文件编写了一个代码,当数据不是整数时,在单元格中移动单独的数据。然后,我被告知对象不支持此属性或方法。如果有人知道为什么会发生这种情况,我想得到一些帮助。谢谢 Sub DIP_Split() Dim wb As Workbook Dim ThisSheet As Worksheet Dim NumOfColumns As Integer Dim RangeToCopy As Range Dim RangeOfHeader
Sub DIP_Split()
Dim wb As Workbook
Dim ThisSheet As Worksheet
Dim NumOfColumns As Integer
Dim RangeToCopy As Range
Dim RangeOfHeader As Range 'data (range) of header row
Dim Filename As String
Dim WorkbookCounter As Integer
Dim RowsInFile 'how many rows (incl. header) in new files?
Application.ScreenUpdating = False
'Initialize data
Set ThisSheet = ThisWorkbook.ActiveSheet
NumOfColumns = ThisSheet.UsedRange.Columns.Count
WorkbookCounter = 1
RowsInFile = 10000 'as your example, just 10 rows per file
'Copy the data of the first row (header)
Set RangeOfHeader = ThisSheet.Range(("A1:A3"), ThisSheet.Cells(1, NumOfColumns))
For p = 4 To ThisSheet.UsedRange.Rows.Count Step RowsInFile - 2
Set wb = Workbooks.Add
'Paste the header row in new file
RangeOfHeader.Copy wb.Sheets(1).Range("A1:A3")
'Delete Header
wb.Sheets(1).Rows(1).EntireRow.Delete
'Paste the chunk of rows for this file
Set RangeToCopy = ThisSheet.Range(ThisSheet.Cells(p, 1), ThisSheet.Cells(p + RowsInFile - 3, NumOfColumns))
RangeToCopy.Copy wb.Sheets(1).Range("A3")
'Create Title and Merge Cell
wb.Sheets(1).Columns("K:K").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
wb.Sheets(1).Range("K1").Font.Name = "Angsana New"
wb.Sheets(1).Range("K1").Value = "xxxx"
wb.Sheets(1).Range("K1:K2").Merge
wb.Sheets(1).Range("O1").HorizontalAlignment = xlCenter
wb.Sheets(1).Range("O1").VerticalAlignment = xlVAlignCenter
wb.Sheets(1).Range("O1").Font.Bold = True
wb.Sheets(1).Range("O1").Font.Name = "Angsana New"
wb.Sheets(1).Range("O1").Value = "xxx"
wb.Sheets(1).Range("O1:O2").Merge
'If not integer move to next row
For Each r In wb.Sheet(1).Range("J3:J100")
If IsNumeric(r.Value) = False Then
r.Cut
r.Offset(, 1).Select
ActiveSheet.Paste
End If
Next r
'Save the new workbook, and close it
wb.SaveAs ThisWorkbook.Path & Filename & Format(Now, "DD-MM-YYYY") & -WorkbookCounter
wb.Close
'Increment file counter
WorkbookCounter = WorkbookCounter + 1
Next p
Application.ScreenUpdating = True
Set wb = Nothing
End Sub
为了便于帮助您,请突出显示发生错误的行。此外,请告知错误是立即发生还是仅当宏命中特定工作簿/数据行时才会发生。这一行中的错误应该是
Sheets(1)
而不是Sheet(1)
:对于wb.Sheet(1)Range(“J3:J100”)中的每个r,它现在正在工作。谢谢。为了便于帮助您,请突出显示发生错误的行。此外,请告知错误是立即发生还是仅当宏命中特定工作簿/数据行时才会发生。这一行中的错误应该是Sheets(1)
而不是Sheet(1)
:对于wb.Sheet(1)Range(“J3:J100”)中的每个r,它现在正在工作。谢谢