用VBA重新筛选条件保存结果

laoau138

用VBA重新筛选条件保存结果

小小水皮1

诶 本来想用数组的 不过智商不够 只能用循环这种慢速度的了  发给你看下 不过用用应该可以了
Sub djk()
Set Rng = Range("p2", Cells(Cells.Rows.Count, "u").End(xlUp)(2, 1))
Rng.Clear
Dim arr, a%, arr1, num%, num2%, k%, arr2
a = [a1].End(xlDown).Row
For i = 1 To a - 1

    ReDim arr(1 To a, 1 To a)
        arr = Range("g" & i + 1, "m" & i + 1)
        arr1 = Application.Transpose(Application.Transpose(arr))
        For Each ar In arr1
            k = k + 1
            If k <= 3 Then
                If ar <> "" Then
             num = num + 1
                End If
        Else
            If ar <> "" Then
            num2 = num2 + 1
            End If
        End If
        
      
        
        Next
        
        If num <> 0 And num2 = 0 Then
     
      
      
        Range("a" & i + 1, "f" & i + 1).Copy Cells(Cells.Rows.Count, "p").End(xlUp)(2, 1)
      
        End If
        k = 0
         num = 0
        num2 = 0
    Next
    Rng.ClearFormats
End Sub

laoau138

小小水皮1 发表于 2016-9-9 19:16
诶 本来想用数组的 不过智商不够 只能用循环这种慢速度的了  发给你看下 不过用用应该可以了
Sub djk()
S ...

'初学者能写出来就不错，不要求太多, 尽量不要用copy  否则速度好慢

'刚找人写了下面这个

Private Sub CommandButton1_Click()
    Dim i%, m%, n%
    k = [p65536].End(3).Row + 1
    Range("p2" & ":u" & k).ClearContents
    For i = 2 To [a65536].End(3).Row
        m = Application.CountA(Range("g" & i & ":i" & i))
        n = Application.CountIf(Range("j" & i & ":m" & i), "")
        k = [p65536].End(3).Row + 1
        If m > 0 And n = 4 Then
            Range("p" & k & ":u" & k).Value = Range("a" & i & ":f" & i).Value
        End If
    Next
End Sub

laoau138

小小水皮1 发表于 2016-9-9 19:16
诶 本来想用数组的 不过智商不够 只能用循环这种慢速度的了  发给你看下 不过用用应该可以了
Sub djk()
S ...

看看这个会不会做

http://www.excelpx.com/thread-424291-1-1.html

小小水皮1

laoau138 发表于 2016-9-9 19:23
'初学者能写出来就不错，不要求太多, 尽量不要用copy  否则速度好慢

'刚找人写了下面这个

厉害啊  学无止尽   

小小水皮1

小小水皮1 发表于 2016-9-9 20:58
厉害啊  学无止尽

对哦 用COUNTA函数  哎  智商捉鸡了