数据维数不能弄错,既然你要5列数据,上面的arra1定义应该是2行5列,下面的RESIZE也得是5列,才能达到你的要求。
- Option Explicit
- Sub 数组提取()
- Dim arr1(1 To 2, 1 To 5), i, j, arr, k
- With Sheet2
- arr = Range("A5:f" & Range("A65536").End(3).Row + 1)
- End With
- k = k + 1
- For i = 1 To UBound(arr)
- 'MsgBox arr(i, 1) = Sheet1.Range("A6")
- If arr(i, 1) = Sheet1.Range("A6") Then
- arr1(k, 1) = arr(i, 1)
- 'arr1(2, 1) = arr(i - 1, 1)
- For j = 2 To 5
- arr1(k, j) = arr(i, j)
- 'arr1(2, j + 2) = arr(i - 1, j)
- Next
- k = k + 1
-
- Else
- If arr(i, 1) = Sheet1.Range("A5") Then
- arr1(k, 1) = arr(i, 1)
- 'arr1(2, 1) = arr(i - 1, 1)
- For j = 2 To 5
- arr1(k, j) = arr(i, j)
- 'arr1(2, j + 2) = arr(i - 1, j)
- Next
- k = k + 1
- End If
- End If
- Next
-
- Sheets("sheet2").Range("l:p").Clear
- Sheets("sheet2").Range("l5").Resize(UBound(arr1), 5) = arr1
- End Sub
复制代码 |