提取数据循环错误

• 1.我试图提取基于D列的数据“Y”。 数据示例文件如下。

  2. [！[提取数据] [1]] [1]

     [1]： http : //i.stack.imgur.com/LnS8i.jpg我是VBA的新手，为了我的目的而采用了web上的代码。 它不工作，并在下面的代码行给出错误的下标超出范围。

如果vArray（i，4）=“Y”那么

3. 我的VBA代码如下

   Sub Extract_Values() Dim wks As Worksheet Dim startRow As Integer Dim lastRow As Integer Dim vArray As Variant Dim vNewArray As Variant Dim i As Integer, j As Integer Dim Counter1 As Integer, Counter2 As Integer startRow = 2 Set wks = Sheets("Sheet1") With wks lastRow = .Cells(Rows.Count, 1).End(xlUp).Row vArray = .Range("A" & startRow & ":B" & lastRow).Value2 For i = 1 To UBound(vArray) If vArray(i, 4) = "Y" Then Counter1 = Counter1 + 1 End If Next i ReDim vNewArray(1 To Counter1, 1 To 2) For j = 1 To UBound(vArray) If vArray(j, 4) = "Y" Then Counter2 = Counter2 + 1 vNewArray(Counter2, 1) = vArray(j, 1) vNewArray(Counter2, 2) = vArray(j, 2) End If Next End With Range("B" & startRow & ":C" & startRow + Counter1 - 1) = vNewArray End Sub 

任何帮助，将不胜感激。

PS：对不起，我应该提到我已经采用了rwilson提到的线程引用代码。 我也一样道歉。

Answer 1

不要太担心。 ）。 尝试这个：

 Sub Extract_Values() Dim wks As Worksheet Dim startRow As Integer Dim lastRow As Integer Dim vArray As Variant Dim vNewArray As Variant Dim i As Integer, j As Integer Dim Counter1 As Integer, Counter2 As Integer startRow = 2 Set wks = Sheets("Sheet1") With wks lastRow = .Cells(Rows.Count, 1).End(xlUp).Row vArray = .Range("A" & startRow & ":D" & lastRow).Value2 For i = 1 To UBound(vArray) If vArray(i, 4) = "Y" Then Counter1 = Counter1 + 1 End If Next i ReDim vNewArray(1 To Counter1, 1 To 2) For j = 1 To UBound(vArray) If vArray(j, 4) = "Y" Then Counter2 = Counter2 + 1 vNewArray(Counter2, 1) = vArray(j, 1) vNewArray(Counter2, 2) = vArray(j, 2) End If Next End With Range("E" & startRow & ":F" & startRow + Counter1 - 1) = vNewArray End Sub