如何对数组进行筛选后复制到工作表？

lanyf

1、如何将sheet1内容先复制到数组，在对供应商为空的进行剔除后，将数据复制sheet2
2、当前只会将sheet1复制到数组，然后数组复制到sheet2，不知道如何实现筛选功能

shiruiqiang

if arr(x,2)<>"" then
k=k+1

fzxba

1. Sub aa()
   
2.   Dim arr, i&, j%, k&
   
3.   With Worksheets("sheet1").Range("A1").CurrentRegion
   
4.     arr = Intersect(.Offset(0), .Offset(1)).Value
   
5.   End With
   
6.   For i = 1 To UBound(arr)
   
7.     If Len(arr(i, 2)) > 0 Then
   
8.       k = k + 1
   
9.       For j = 1 To UBound(arr, 2)
   
10.         arr(k, j) = arr(i, j)
    
11.       Next
    
12.     End If
    
13.   Next
    
14.   With Worksheets("sheet2").Range("A2")
    
15.     .CurrentRegion.Clear
    
16.     With .Resize(k, UBound(arr, 2))
    
17.       .Value = arr
    
18.       .Borders.LineStyle = xlContinuous
    
19.       .HorizontalAlignment = xlLeft
    
20.       .Rows(1).Font.Bold = True
    
21.     End With
    
22.   End With
    
23. End Sub

复制代码

lsc900707

for i=3 to ubound(arr)
  if instr(arr(i,2))>0 then m=m+1
next
.Resize(m, UBound(arr, 2)) = arr

那时雨

帮助别人，提高自我！最快的数组去除空值方案。

1. Sub 数组去空值()
   
2.     Dim arr, LastRow&, r&
   
3.     With Sheets("Sheet1")
   
4.         LastRow = .Cells(Rows.Count, 2).End(xlUp).Row
   
5.         arr = .Range("B3:B" & LastRow)
   
6.         arr = Split(Application.Trim(Join(Application.Transpose(arr))))
   
7.     End With
   
8.     With Sheets("Sheet2")
   
9.         For r = 3 To UBound(arr) + 3
   
10.             .Cells(r, 1) = r - 2
    
11.         Next r
    
12.         .Range("A2:B2") = Array("制造周期", "供应商")
    
13.         .Range("A2:B2").Font.Bold = True
    
14.         .Range("B3").Resize(UBound(arr), 1) = Application.Transpose(arr)
    
15.     End With
    
16. End Sub

复制代码

gwjkkkkk

Sub TEST()
    Dim arr, i&, j&, R&
    arr = [A2].CurrentRegion
    For i = 1 To UBound(arr)
      If arr(i, 2) <> "" Then
         R = R + 1
         For j = 1 To UBound(arr, 2)
            arr(R, j) = arr(i, j)
         Next j
      End If
    Next i
    Sheets(2).Cells.Clear
    Sheets(2).[A1].Resize(R, UBound(arr, 2)) = arr
    With Sheets(2).[A1].CurrentRegion
        .HorizontalAlignment = xlCenter
        .Borders.LineStyle = xlContinuous
        .Rows(1).Font.Bold = True
        .EntireColumn.AutoFit
        .EntireRow.AutoFit
    End With
End Sub

gwjkkkkk

请参考附件。。。