Question

excel vba编码，想将Sheet1中的内容筛选到Sheet2中，但一直报错“下标越界”。代码如下：

Sub 筛选()
Dim a%, b%, c%, i%, j%, r%
Dim arr1() As String, arr2() As String
b = Sheets("Sheet1").[F65536].End(xlUp).Row
c = Application.WorksheetFunction.CountIf(Sheets(1).Range("F2:F" & b), "<=7") - Application.WorksheetFunction.CountIf(Sheets(1).Range("F2:F" & b), "<=0")
ReDim arr1(1 To c) As String, arr2(1 To c) As String
i = 1
j = 1
For r = 2 To c + 1
For a = 2 To b
If Cells(a, 6).Value <= 7 And Cells(a, 6).Value > 0 Then
arr1(i) = Left(Sheets(1).Range("A" & a), 50) & "@genomics.cn"
arr2(j) = Left(Sheets(1).Range("B" & a), 50) & "@genomics.cn"
Sheets(2).Cells(r, 1).Value = arr1(i)
Sheets(2).Cells(r, 2).Value = arr2(j)
End If
i = i + 1
j = j + 1
Next
Next
End Sub

Answer 1

我想你是数组定义错误，数组的下标应该是0开始的，请试试：
Sub 筛选()
Dim a%, b%, c%, i%, j%, r%
Dim arr1() As String, arr2() As String
b = Sheets("Sheet1").[F65536].End(xlUp).Row
c = Application.WorksheetFunction.CountIf(Sheets(1).Range("F2:F" & b), "<=7") - Application.WorksheetFunction.CountIf(Sheets(1).Range("F2:F" & b), "<=0")
ReDim arr1(0 To c-1) As String, arr2(0 To c-1) As String
i = 0
j = 0
For r = 2 To c+1
For a = 2 To b
If Cells(a, 6).Value <= 7 And Cells(a, 6).Value > 0 Then
arr1(i) = Left(Sheets(1).Range("A" & a), 50) & "@genomics.cn"
arr2(j) = Left(Sheets(1).Range("B" & a), 50) & "@genomics.cn"
Sheets(2).Cells(r, 1).Value = arr1(i)
Sheets(2).Cells(r, 2).Value = arr2(j)
End If
i = i + 1
j = j + 1
Next
Next
End Sub