[已解决]VBA运行出现问题

wszsp

数据筛选的程序，出现问题：
源数据sheet1中，数据的行数大于几百行时没问题，数据行数少了后就出现问题。
请老师们指点。
具体见附件。

最佳答案

月排行榜 / 总排行榜

高

2017-10-30 18:30

Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False
    If Target.Address = "$A$1" Or Target.Address = "$C$1" Or Target.Address = "$D$1" Then
        If Target.Count = 1 Then
            Dim ar, br()
            Dim i As Long, j As Long
            Dim qs As Date, jz As Date, sr As String
            With Sheets(2)
                qs = .Cells(1, 1): jz = .Cells(1, 3): sr = Cells(1, 4)
                ar = Sheets(1).Cells(3, 1).CurrentRegion
                For i = 1 To UBound(ar)
                    If ar(i, 1) >= qs And ar(i, 1) <= jz And ar(i, 3) = sr Then
                        j = j + 1
               ReDim Preserve br(1 To 6, 1 To j)
                        br(1, j) = ar(i, 1)
                        br(2, j) = ar(i, 2)
                        br(3, j) = ar(i, 3)
                        br(4, j) = ar(i, 4)
                        br(5, j) = ar(i, 5)
                        br(6, j) = ar(i, 6)
                    End If
                Next i
                .Cells(3, 1).Resize(Rows.Count - 2, 6).ClearContents
                .Cells(10, 1).Resize(j, 6) = Application.Transpose(br)  '第十行开始写入
            End With
        End If
    End If
    Application.EnableEvents = True
End Sub
一般来说，不应定义1000行的数组，而是应该定义一个动态数组，注意行列要先转一下，读取时再转置回来。这是一个动态数组扩充的例子。

跳转到最佳答案楼层

高

Application.EnableEvents = False
                .Cells(10, 1).Resize(j, 6) = br  '第十行开始写入
         
    Application.EnableEvents = True

高

Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False
    If Target.Address = "$A$1" Or Target.Address = "$C$1" Or Target.Address = "$D$1" Then
        If Target.Count = 1 Then
            Dim ar, br()
            Dim i As Long, j As Long
            Dim qs As Date, jz As Date, sr As String
            With Sheets(2)
                qs = .Cells(1, 1): jz = .Cells(1, 3): sr = Cells(1, 4)
                ar = Sheets(1).Cells(3, 1).CurrentRegion
                For i = 1 To UBound(ar)
                    If ar(i, 1) >= qs And ar(i, 1) <= jz And ar(i, 3) = sr Then
                        j = j + 1
               ReDim Preserve br(1 To 6, 1 To j)
                        br(1, j) = ar(i, 1)
                        br(2, j) = ar(i, 2)
                        br(3, j) = ar(i, 3)
                        br(4, j) = ar(i, 4)
                        br(5, j) = ar(i, 5)
                        br(6, j) = ar(i, 6)
                    End If
                Next i
                .Cells(3, 1).Resize(Rows.Count - 2, 6).ClearContents
                .Cells(10, 1).Resize(j, 6) = Application.Transpose(br)  '第十行开始写入
            End With
        End If
    End If
    Application.EnableEvents = True
End Sub
一般来说，不应定义1000行的数组，而是应该定义一个动态数组，注意行列要先转一下，读取时再转置回来。这是一个动态数组扩充的例子。

wszsp

   .Cells(3, 1).Resize(Rows.Count - 2, 6).ClearContents
这一句 ，也改成从第10行清空 ，怎么改？
                .Cells(10, 1).Resize(j, 6) = Application.Transpose(br)  '第十行开始写入