
Sub byw()
Dim arr, arr1
Dim i%, j%, s%
arr = Sheet6.Range("A1:K" & [A65536].End(3).Row) '第一行为标题行'
ReDim arr1(1 To UBound(arr), 1 To 11)
s = 1
For i = 2 To UBound(arr) '数据区域从第二行开始'
If arr(i, 10) = "是" Then
For j = 1 To 11
'arr1(s, j) = arr(i, j) '如果不改变数组的排列
arr1(s, 1) = s '我给加的一个序号
arr1(s, 2) = arr(i, 5)
arr1(s, 3) = arr(i, 4)
arr1(s, 4) = arr(i, 3)
arr1(s, 5) = arr(i, 1)
arr1(s, 6) = arr(i, 6)
Next
s = s + 1
End If
Next
Sheet1.Range("A4:AU100").ClearContents
Sheet1.[A4].Resize(s, 6) = arr1
End Sub
Dim arr, arr1
Dim i%, j%, s%
arr = Sheet6.Range("A1:K" & [A65536].End(3).Row) '第一行为标题行'
ReDim arr1(1 To UBound(arr), 1 To 11)
s = 1
For i = 2 To UBound(arr) '数据区域从第二行开始'
If arr(i, 10) = "是" Then
For j = 1 To 11
'arr1(s, j) = arr(i, j) '如果不改变数组的排列
arr1(s, 1) = s '我给加的一个序号
arr1(s, 2) = arr(i, 5)
arr1(s, 3) = arr(i, 4)
arr1(s, 4) = arr(i, 3)
arr1(s, 5) = arr(i, 1)
arr1(s, 6) = arr(i, 6)
Next
s = s + 1
End If
Next
Sheet1.Range("A4:AU100").ClearContents
Sheet1.[A4].Resize(s, 6) = arr1
End Sub
以上代码会经常使用,可收藏!