我有一些宏相互合作，将数据排序并整理到相关标签中，并且似乎遇到一个问题，一旦数据到达第2500行，宏就不再正常工作了。
第一个运行的是一个排序（排序）宏，它接收所有数据并将其分类到我已调用的标签中的相关列中。＆＃39; macrolist＆＃39;根据他们的类别：
Dim LastRow As Integer ', LastCell as String
'
' This is the visual basic to sort the data sheet for excel 2003
Range("B2:S5002").Select
Selection.Sort Key1:=Range("D3"), Order1:=xlAscending, Key2:=Range("B3") _
, Order2:=xlAscending, Key3:=Range("E3"), Order3:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, DataOption3:= _
xlSortNormal
'Go to the macrolist sheet and run each filter macro
Sheets("macrolist").Select
Application.Run "kittensfilter"
Application.Run "catsfilter"
Application.Run "housecatsfilter"
Application.Run "lionsfilter"
Application.Run "mountainlionsfilter"
Application.Run "wbfilter"
Application.Run "triconfilter"
Application.Run "schedulefilter"
'go back to the data sheet and select the last entered job
Sheets("data").Select
LastRow = Worksheets("data").Range("U2").Value
Cells(LastRow, 2).Select
'selection of a range
'lastCell = Range(Cells(LastRow, 1), Cells(LastRow, 2)).Address
'Range(lastCell).Select
'enter a timestamp
Worksheets("data").Range("C1") = Time
Worksheets("data").Range("D1") = Date
我遇到问题的两个是小猫和小狗过滤器;当它到达数据选项卡上的某个点（关于第2500行）时，它们只是停止向前推进符合条件的新信息。根据我的代码，我知道这应该发生在第5002行，但它似乎是在之前的点上随机发生的。
以下是两个过滤器：
Sub kittensfilter()
Dim MaxResults As Integer, MyCol As Integer, ResultsRng As String
Dim MyRow As Integer, LastDataRow As Integer, DataRng As String
Dim CritRow As Integer, CritRng As String, RightCol As Integer
Dim TopRow As Integer, BottomRow As Integer, LeftCol As Integer
' the source data MUST be in a worksheet called 'Data'
' *** MODIFY AND SET YOUR OWN RANGES ON THE FOLLOWING DECLARATIONS ***
' cell Data!"?" contains the last row number of data
LastDataRow = Worksheets("data").Range("U2").Value
DataRng = "data!A2:S2" ' range of column headers for Data table
CritRng = "macrolist!C3:U11" ' range of cells for Criteria table
ResultsRng = "macrolist!C13:U13" ' range of headers for Results table
MaxResults = 214 ' any value higher than the number of possible results
' **************** END OF DECLARATIONS *********************
' fix the data range to incorporate the last row
TopRow = Worksheets("data").Range(DataRng).Row
LeftCol = Worksheets("data").Range(DataRng).Column
RightCol = LeftCol + Worksheets("data").Range(DataRng).Columns.Count - 1
DataRng = "data!" & Range(Cells(TopRow, LeftCol), Cells(LastDataRow, RightCol)).Address
' fix the results range to incorporate the last row
TopRow = Worksheets("macrolist").Range(ResultsRng).Row
LeftCol = Worksheets("macrolist").Range(ResultsRng).Column
RightCol = LeftCol + Worksheets("macrolist").Range(ResultsRng).Columns.Count - 1
ResultsRng = "macrolist!" & Range(Cells(TopRow + 1, LeftCol), Cells(MaxResults, RightCol)).Address
Range(ResultsRng).ClearContents ' clear any previous results but not headers
ResultsRng = "macrolist!" & Range(Cells(TopRow, LeftCol), Cells(MaxResults, RightCol)).Address
' fix the criteria range and identify the last row containing any items
TopRow = Worksheets("macrolist").Range(CritRng).Row
BottomRow = TopRow + Worksheets("macrolist").Range(CritRng).Rows.Count - 1
LeftCol = Worksheets("macrolist").Range(CritRng).Column
RightCol = LeftCol + Worksheets("macrolist").Range(CritRng).Columns.Count - 1
CritRow = 0
For MyRow = TopRow + 1 To BottomRow
For MyCol = LeftCol To RightCol
If Cells(MyRow, MyCol).Value <> "" Then CritRow = MyRow
Next
Next
If CritRow = 0 Then
MsgBox "No Criteria detected", "MeadInKent"
Else
CritRng = "macrolist!" & Range(Cells(TopRow, LeftCol), Cells(CritRow, RightCol)).Address
'Debug.Print "DataRng, CritRng, ResultsRng: ", DataRng, CritRng, ResultsRng
Worksheets("data").Range(DataRng).AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Range(CritRng), CopyToRange:=Range(ResultsRng), _
Unique:=False
End If
'Range("A5").Select
Worksheets("black").Range("f4") = Time
Worksheets("black").Range("f5") = Date
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
End Sub
Sub catsfilter()
Dim MaxResults As Integer, MyCol As Integer, ResultsRng As String
Dim MyRow As Integer, LastDataRow As Integer, DataRng As String
Dim CritRow As Integer, CritRng As String, RightCol As Integer
Dim TopRow As Integer, BottomRow As Integer, LeftCol As Integer
' the source data MUST be in a worksheet called 'Data'
' *** MODIFY AND SET YOUR OWN RANGES ON THE FOLLOWING DECLARATIONS ***
' cell Data!"?" contains the last row number of data
LastDataRow = Worksheets("data").Range("U2").Value
DataRng = "data!A2:S2" ' range of column headers for Data table
CritRng = "macrolist!BN3:CF11" ' range of cells for Criteria table
ResultsRng = "macrolist!BN13:CF13" ' range of headers for Results table
MaxResults = 214 ' any value higher than the number of possible results
' **************** END OF DECLARATIONS *********************
' fix the data range to incorporate the last row
TopRow = Worksheets("data").Range(DataRng).Row
LeftCol = Worksheets("data").Range(DataRng).Column
RightCol = LeftCol + Worksheets("data").Range(DataRng).Columns.Count - 1
DataRng = "data!" & Range(Cells(TopRow, LeftCol), Cells(LastDataRow, RightCol)).Address
' fix the results range to incorporate the last row
TopRow = Worksheets("macrolist").Range(ResultsRng).Row
LeftCol = Worksheets("macrolist").Range(ResultsRng).Column
RightCol = LeftCol + Worksheets("macrolist").Range(ResultsRng).Columns.Count - 1
ResultsRng = "macrolist!" & Range(Cells(TopRow + 1, LeftCol), Cells(MaxResults, RightCol)).Address
Range(ResultsRng).ClearContents ' clear any previous results but not headers
ResultsRng = "macrolist!" & Range(Cells(TopRow, LeftCol), Cells(MaxResults, RightCol)).Address
' fix the criteria range and identify the last row containing any items
TopRow = Worksheets("macrolist").Range(CritRng).Row
BottomRow = TopRow + Worksheets("macrolist").Range(CritRng).Rows.Count - 1
LeftCol = Worksheets("macrolist").Range(CritRng).Column
RightCol = LeftCol + Worksheets("macrolist").Range(CritRng).Columns.Count - 1
CritRow = 0
For MyRow = TopRow + 1 To BottomRow
For MyCol = LeftCol To RightCol
If Cells(MyRow, MyCol).Value <> "" Then CritRow = MyRow
Next
Next
If CritRow = 0 Then
MsgBox "No Criteria detected", "MeadInKent"
Else
CritRng = "macrolist!" & Range(Cells(TopRow, LeftCol), Cells(CritRow, RightCol)).Address
'Debug.Print "DataRng, CritRng, ResultsRng: ", DataRng, CritRng, ResultsRng
Worksheets("data").Range(DataRng).AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Range(CritRng), CopyToRange:=Range(ResultsRng), _
Unique:=False
End If
'Range("A5").Select
Worksheets("finished").Range("C4") = Time
Worksheets("finished").Range("C5") = Date
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
End Sub
这两者都采用了“宏观主义者”中提供的信息。选项卡并将其复制到相应的“小猫”中。和猫的＃39;标签。
我认为主要问题在于排序功能，但我无法弄清楚应该改变什么以使其继续按需运行。我已经尝试过增加/减少范围，但它们似乎没有效果。
感谢任何帮助。