返回列表 上一主題 發帖

[發問] 列出更多的對應資料

本帖最後由 n7822123 於 2020-8-22 23:16 編輯

回復 29# 軒云熊

你可以繼續努力~~

自己辛苦寫出來的程式,會很有成就感!

學習就是不斷嘗試錯誤的過程~

相反,如果只抄別人的程式,就認為自己已經會的那種人....是學不好的

以為自己已經看懂,但就是不能自己寫出來~
程式是依需求寫的,需求表達不清楚
或者沒有上傳附件,愛莫能助

TOP

本帖最後由 軒云熊 於 2020-8-23 04:05 編輯

謝謝 n7822123 前輩的鼓勵  每寫一次我就會多一次經驗 我會繼續努力的:P

回復 30# qaqa3296
   
抱歉 沒有注意到 我改這樣 你看看是不是這樣的結果

Public Sub 模糊篩選()
Application.ScreenUpdating = False
Range(Sheets(2).Cells(2, 1), Sheets(2).Cells(2, 4).End(xlDown)).Font.Color = RGB(255, 0, 0)
G = True
Sheets(3).Select
Sheets(3).Range(Cells(1, 1), Cells(1, 4).End(xlDown)).Clear
Sheets(2).Select

For K = 2 To Cells(2, 5).End(xlDown).Row
    x = Sheets(1).Cells(K, 3)
    If Sheets(1).Cells(K, 1) = "" Then Exit For
    For i = 2 To Cells(2, 3).End(xlDown).Row '依條件篩選

        If Sheets(1).Cells(K, 3) = "" And Asc(Sheets(1).Cells(K, 2)) > 127 Or Asc(Sheets(1).Cells(K, 2)) < 0 Then
            Cells(i, 1).AutoFilter Field:=2, Criteria1:=Sheets(1).Cells(K, 2)
            Range(Sheets(2).Cells(2, 1), Sheets(2).Cells(2, 4).End(xlDown)).Font.Color = RGB(0, 0, 0)
            
            If Range(Sheets(2).Cells(2, 1), Sheets(2).Cells(2, 4).End(xlDown)).Count - 1 And Sheets(1).Cells(K, 3) = "" Then
                Sheets(2).Cells(2, 3).AutoFilter
                Cells(i, 1).AutoFilter Field:=1, Criteria1:=Sheets(1).Cells(K, 1)
                Range(Sheets(2).Cells(2, 1), Sheets(2).Cells(2, 4).End(xlDown)).Font.Color = RGB(0, 0, 0)
            End If

            
        Else
           Cells(i, 1).AutoFilter Field:=3, Criteria1:="*" & x & "*"
           Range(Sheets(2).Cells(2, 1), Sheets(2).Cells(2, 4).End(xlDown)).Font.Color = RGB(0, 0, 0)
        End If
        
        If G = True Then
           Range(Sheets(2).Cells(1, 1), Sheets(2).Cells(1, 4).End(xlDown)).Copy Sheets(3).Cells(1, 1)
           G = False
        Else
           Range(Sheets(2).Cells(2, 1), Sheets(2).Cells(2, 4).End(xlDown)).Copy Sheets(3).Cells(1, 1).End(xlDown).Offset(1, 0)
        End If
        Sheets(2).Cells(2, 3).AutoFilter
    Exit For
    Next i
Next K
Sheets(3).Select
Range(Sheets(3).Cells(2, 1), Sheets(3).Cells(2, 4).End(xlDown)).RemoveDuplicates Columns:=1
Range(Sheets(3).Cells(2, 1), Sheets(3).Cells(2, 4).End(xlDown)).Font.Color = RGB(0, 0, 0)
Application.ScreenUpdating = True
End Sub
javascript:;

列出更多資料V6001.rar (32.59 KB)

TOP

如果是 品名還有規格 打錯字 我是改這樣 但是 規格的結果跟 準大的不同   
Public Sub 模糊篩選()
Application.ScreenUpdating = False
Range(Sheets(2).Cells(2, 1), Sheets(2).Cells(2, 4).End(xlDown)).Font.Color = RGB(255, 0, 0)
G = True
Sheets(3).Select
Sheets(3).Range(Cells(1, 1), Cells(1, 4).End(xlDown)).Clear
Sheets(2).Select

For K = 2 To Cells(2, 5).End(xlDown).Row
    x = Sheets(1).Cells(K, 3)
    If Sheets(1).Cells(K, 1) = "" Then Exit For
    For i = 2 To Cells(2, 3).End(xlDown).Row '依條件篩選

        If Sheets(1).Cells(K, 3) = "" And Asc(Sheets(1).Cells(K, 2)) > 127 Or Asc(Sheets(1).Cells(K, 2)) < 0 Then
            Cells(i, 1).AutoFilter Field:=2, Criteria1:=Sheets(1).Cells(K, 2)
            Range(Sheets(2).Cells(2, 1), Sheets(2).Cells(2, 4).End(xlDown)).Font.Color = RGB(0, 0, 0)
            
            If Range(Sheets(2).Cells(2, 1), Sheets(2).Cells(2, 4).End(xlDown)).Count - 1 And Sheets(1).Cells(K, 3) = "" Then
                Sheets(2).Cells(2, 3).AutoFilter
                Cells(i, 1).AutoFilter Field:=1, Criteria1:=Sheets(1).Cells(K, 1)
                Range(Sheets(2).Cells(2, 1), Sheets(2).Cells(2, 4).End(xlDown)).Font.Color = RGB(0, 0, 0)
                If Range(Sheets(2).Cells(2, 1), Sheets(2).Cells(2, 4).End(xlDown)).Count - 1 And Sheets(1).Cells(K, 3) <> "" Then
                    Sheets(2).Cells(2, 3).AutoFilter
                    Cells(i, 1).AutoFilter Field:=1, Criteria1:=Sheets(1).Cells(K, 1)
                    Range(Sheets(2).Cells(2, 1), Sheets(2).Cells(2, 4).End(xlDown)).Font.Color = RGB(0, 0, 0)
                End If
            End If
            
        Else
           Cells(i, 1).AutoFilter Field:=3, Criteria1:="*" & x & "*"
           Range(Sheets(2).Cells(2, 1), Sheets(2).Cells(2, 4).End(xlDown)).Font.Color = RGB(0, 0, 0)
        End If
        
        If G = True Then
           Range(Sheets(2).Cells(1, 1), Sheets(2).Cells(1, 4).End(xlDown)).Copy Sheets(3).Cells(1, 1)
           G = False
        Else
           Range(Sheets(2).Cells(2, 1), Sheets(2).Cells(2, 4).End(xlDown)).Copy Sheets(3).Cells(1, 1).End(xlDown).Offset(1, 0)
        End If
        Sheets(2).Cells(2, 3).AutoFilter
    Exit For
    Next i
Next K
Sheets(3).Select
Range(Sheets(3).Cells(2, 1), Sheets(3).Cells(2, 4).End(xlDown)).RemoveDuplicates Columns:=1
Range(Sheets(3).Cells(2, 1), Sheets(3).Cells(2, 4).End(xlDown)).Font.Color = RGB(0, 0, 0)
Application.ScreenUpdating = True
End Sub

TOP

回復 33# 軒云熊

感謝軒云熊改進程式碼

資料還差一些

你的程式執行完後必須刪除重複項目

附上我最終需要的顯示效果與准大比較,這樣比較容易觀看

列出更多資料V7資料呈現.zip (49.29 KB)

TOP

本帖最後由 軒云熊 於 2020-8-24 22:41 編輯

回復 34# qaqa3296
沒辦法了 想不出來 文字的格式太複雜了...  如果是用 asc 方法 會寫得更長....只能借用 准提部林大大 還有 n7822123大大 們的邏輯...才能辦到 >"<
Public Sub 模糊篩選()

Application.ScreenUpdating = False
Range(Sheets(2).Cells(2, 1), Sheets(2).Cells(2, 4).End(xlDown)).Font.Color = RGB(255, 0, 0)
G = True
Sheets(3).Select
Sheets(3).Range(Cells(1, 1), Cells(1, 4).End(xlDown)).Clear
Sheets(2).Select

For K = 2 To Cells(2, 5).End(xlDown).Row
    X = Trim(Sheets(1).Cells(K, 3))
    If Sheets(1).Cells(K, 1) = "" Then Exit For
   
    For i = 2 To Cells(2, 3).End(xlDown).Row '依條件篩選

        If X <> "" Then
        
            Sheets(2).Cells(2, 3).AutoFilter
            Cells(i, 1).AutoFilter Field:=3, Criteria1:="=*" & Mid(X, 1, 8) & "*", Operator:=xlOr, Criteria2:="=" & X & ""
            Range(Sheets(2).Cells(2, 1), Sheets(2).Cells(2, 4).End(xlDown)).Font.Color = RGB(0, 0, 0)

            Cells(i, 1).AutoFilter Field:=3, Criteria1:="=*" & Mid(X, 1, 5) & "*", Operator:=xlOr, Criteria2:="=" & X & ""
            Range(Sheets(2).Cells(2, 1), Sheets(2).Cells(2, 4).End(xlDown)).Font.Color = RGB(0, 0, 0)
            
            If X Like "####[-.]*" Or X Like "####[A-Z]*" Then
                Cells(i, 1).AutoFilter Field:=3, Criteria1:="=*" & Mid(X, 1, 4) & "*", Operator:=xlOr, Criteria2:="=" & X & ""
                Range(Sheets(2).Cells(2, 1), Sheets(2).Cells(2, 4).End(xlDown)).Font.Color = RGB(0, 0, 0)
            End If

            If ActiveSheet.AutoFilter.Range.SpecialCells(xlCellTypeVisible).Areas.Count = 1 Then
                Sheets(2).Cells(2, 3).AutoFilter
                Cells(i, 1).AutoFilter Field:=2, Criteria1:="=*" & X & "*", Operator:=xlOr, Criteria2:="=" & X & ""
                Range(Sheets(2).Cells(2, 1), Sheets(2).Cells(2, 4).End(xlDown)).Font.Color = RGB(0, 0, 0)
               
                Cells(i, 1).AutoFilter Field:=2, Criteria1:=Sheets(1).Cells(K, 2)
                Range(Sheets(2).Cells(2, 1), Sheets(2).Cells(2, 4).End(xlDown)).Font.Color = RGB(0, 0, 0)
            End If
        End If
         
        If X = "" Then
            X = Trim(Sheets(1).Cells(K, 2))
            Cells(i, 1).AutoFilter Field:=2, Criteria1:="=*" & X & "*", Operator:=xlOr, Criteria2:=Sheets(1).Cells(K, 2)
            Range(Sheets(2).Cells(2, 1), Sheets(2).Cells(2, 4).End(xlDown)).Font.Color = RGB(0, 0, 0)
            If ActiveSheet.AutoFilter.Range.SpecialCells(xlCellTypeVisible).Areas.Count = 1 Then
                Sheets(2).Cells(2, 3).AutoFilter
                Cells(i, 1).AutoFilter Field:=1, Criteria1:=Sheets(1).Cells(K, 1)
                Range(Sheets(2).Cells(2, 1), Sheets(2).Cells(2, 4).End(xlDown)).Font.Color = RGB(0, 0, 0)
            If ActiveSheet.AutoFilter.Range.SpecialCells(xlCellTypeVisible).Areas.Count = 1 Then
            Exit For
            End If
                Range(Sheets(2).Cells(2, 1), Sheets(2).Cells(2, 4).End(xlDown)).Font.Color = RGB(0, 0, 0)
            End If
        End If
        
    Exit For
    Next i
   
    If G = True Then
        Range(Sheets(2).Cells(1, 1), Sheets(2).Cells(1, 4).End(xlDown)).Copy Sheets(3).Cells(1, 1)
        G = False
    Else
        Range(Sheets(2).Cells(2, 1), Sheets(2).Cells(2, 4).End(xlDown)).Copy Sheets(3).Cells(1, 1).End(xlDown).Offset(1, 0)
    End If
    Sheets(2).Cells(2, 3).AutoFilter

Next K
Sheets(3).Select
Range(Sheets(3).Cells(2, 1), Sheets(3).Cells(2, 4).End(xlDown)).RemoveDuplicates Columns:=1
Range(Sheets(3).Cells(2, 1), Sheets(3).Cells(2, 4).End(xlDown)).Font.Color = RGB(0, 0, 0)
Application.ScreenUpdating = True
End Sub

TOP

回復 35# 軒云熊

目前測試

如果規格為空白(忘記打),依當初定的條件來看,只會列出那列的資料,但看起來你把該列有相同品名的關鍵字全部找出來了。

TOP

回復 36# qaqa3296

再加一個 判斷應該可以了 你試試看

Public Sub 模糊篩選()

Application.ScreenUpdating = False
Range(Sheets(2).Cells(2, 1), Sheets(2).Cells(2, 4).End(xlDown)).Font.Color = RGB(255, 0, 0)
G = True
Sheets(3).Select
Sheets(3).Range(Cells(1, 1), Cells(1, 4).End(xlDown)).Clear
Sheets(2).Select

For K = 2 To Cells(2, 5).End(xlDown).Row
    X = Trim(Sheets(1).Cells(K, 3))
    If Sheets(1).Cells(K, 1) = "" Then Exit For
   
    For i = 2 To Cells(2, 3).End(xlDown).Row '依條件篩選

        If X <> "" And Sheets(1).Cells(K, 3) <> "" Then
        
            Sheets(2).Cells(2, 3).AutoFilter
            Cells(i, 1).AutoFilter Field:=3, Criteria1:="=*" & Mid(X, 1, 8) & "*", Operator:=xlOr, Criteria2:="=" & X & ""
            Range(Sheets(2).Cells(2, 1), Sheets(2).Cells(2, 4).End(xlDown)).Font.Color = RGB(0, 0, 0)

            Cells(i, 1).AutoFilter Field:=3, Criteria1:="=*" & Mid(X, 1, 5) & "*", Operator:=xlOr, Criteria2:="=" & X & ""
            Range(Sheets(2).Cells(2, 1), Sheets(2).Cells(2, 4).End(xlDown)).Font.Color = RGB(0, 0, 0)
            
            If X Like "####[-.]*" Or X Like "####[A-Z]*" Then
                Cells(i, 1).AutoFilter Field:=3, Criteria1:="=*" & Mid(X, 1, 4) & "*", Operator:=xlOr, Criteria2:="=" & X & ""
                Range(Sheets(2).Cells(2, 1), Sheets(2).Cells(2, 4).End(xlDown)).Font.Color = RGB(0, 0, 0)
            End If

            If ActiveSheet.AutoFilter.Range.SpecialCells(xlCellTypeVisible).Areas.Count = 1 Then
                Sheets(2).Cells(2, 3).AutoFilter
                Cells(i, 1).AutoFilter Field:=2, Criteria1:="=*" & X & "*", Operator:=xlOr, Criteria2:="=" & X & ""
                Range(Sheets(2).Cells(2, 1), Sheets(2).Cells(2, 4).End(xlDown)).Font.Color = RGB(0, 0, 0)
               
                Cells(i, 1).AutoFilter Field:=2, Criteria1:=Sheets(1).Cells(K, 2)
                Range(Sheets(2).Cells(2, 1), Sheets(2).Cells(2, 4).End(xlDown)).Font.Color = RGB(0, 0, 0)
            End If
        End If
         
        If X = "" Then
            X = Trim(Sheets(1).Cells(K, 2))
            Cells(i, 1).AutoFilter Field:=2, Criteria1:="=*" & X & "*", Operator:=xlOr, Criteria2:=Sheets(1).Cells(K, 2)
            Range(Sheets(2).Cells(2, 1), Sheets(2).Cells(2, 4).End(xlDown)).Font.Color = RGB(0, 0, 0)
            If ActiveSheet.AutoFilter.Range.SpecialCells(xlCellTypeVisible).Areas.Count = 1 Then
                Sheets(2).Cells(2, 3).AutoFilter
                Cells(i, 1).AutoFilter Field:=1, Criteria1:=Sheets(1).Cells(K, 1)
                Range(Sheets(2).Cells(2, 1), Sheets(2).Cells(2, 4).End(xlDown)).Font.Color = RGB(0, 0, 0)
            If ActiveSheet.AutoFilter.Range.SpecialCells(xlCellTypeVisible).Areas.Count = 1 Then
            Exit For
            End If
                Range(Sheets(2).Cells(2, 1), Sheets(2).Cells(2, 4).End(xlDown)).Font.Color = RGB(0, 0, 0)
            End If
        End If
        
    Exit For
    Next i
   
    If G = True Then
        Range(Sheets(2).Cells(1, 1), Sheets(2).Cells(1, 4).End(xlDown)).Copy Sheets(3).Cells(1, 1)
        G = False
    Else
        Range(Sheets(2).Cells(2, 1), Sheets(2).Cells(2, 4).End(xlDown)).Copy Sheets(3).Cells(1, 1).End(xlDown).Offset(1, 0)
    End If
    Sheets(2).Cells(2, 3).AutoFilter

Next K
Sheets(3).Select
Range(Sheets(3).Cells(2, 1), Sheets(3).Cells(2, 4).End(xlDown)).RemoveDuplicates Columns:=1
Range(Sheets(3).Cells(2, 1), Sheets(3).Cells(2, 4).End(xlDown)).Font.Color = RGB(0, 0, 0)
Application.ScreenUpdating = True
End Sub

TOP

回復 36# qaqa3296

如果是 規格 或是 品名 其中一個忘記打
Public Sub 模糊篩選()

Application.ScreenUpdating = False
Range(Sheets(2).Cells(2, 1), Sheets(2).Cells(2, 4).End(xlDown)).Font.Color = RGB(255, 0, 0)
G = True
Sheets(3).Select
Sheets(3).Range(Cells(1, 1), Cells(1, 4).End(xlDown)).Clear
Sheets(2).Select

For K = 2 To Cells(2, 5).End(xlDown).Row
    X = Trim(Sheets(1).Cells(K, 3))
    If Sheets(1).Cells(K, 1) = "" Then Exit For
   
    For i = 2 To Cells(2, 3).End(xlDown).Row '依條件篩選

        If X <> "" And Sheets(1).Cells(K, 3) <> "" Then
            
            Sheets(2).Cells(2, 3).AutoFilter
            Cells(i, 1).AutoFilter Field:=3, Criteria1:="=*" & Mid(X, 1, 8) & "*", Operator:=xlOr, Criteria2:="=" & X & ""
            Range(Sheets(2).Cells(2, 1), Sheets(2).Cells(2, 4).End(xlDown)).Font.Color = RGB(0, 0, 0)

            Cells(i, 1).AutoFilter Field:=3, Criteria1:="=*" & Mid(X, 1, 5) & "*", Operator:=xlOr, Criteria2:="=" & X & ""
            Range(Sheets(2).Cells(2, 1), Sheets(2).Cells(2, 4).End(xlDown)).Font.Color = RGB(0, 0, 0)
            
            If X Like "####[-.]*" Or X Like "####[A-Z]*" Then
                Cells(i, 1).AutoFilter Field:=3, Criteria1:="=*" & Mid(X, 1, 4) & "*", Operator:=xlOr, Criteria2:="=" & X & ""
                Range(Sheets(2).Cells(2, 1), Sheets(2).Cells(2, 4).End(xlDown)).Font.Color = RGB(0, 0, 0)
            End If

            If Sheets(1).Cells(K, 2) <> "" Then
                 If ActiveSheet.AutoFilter.Range.SpecialCells(xlCellTypeVisible).Areas.Count = 1 Then
                     Sheets(2).Cells(2, 3).AutoFilter
                     Cells(i, 1).AutoFilter Field:=2, Criteria1:="=*" & X & "*", Operator:=xlOr, Criteria2:="=" & X & ""
                     Range(Sheets(2).Cells(2, 1), Sheets(2).Cells(2, 4).End(xlDown)).Font.Color = RGB(0, 0, 0)
                     
                     Cells(i, 1).AutoFilter Field:=2, Criteria1:=Sheets(1).Cells(K, 2)
                     Range(Sheets(2).Cells(2, 1), Sheets(2).Cells(2, 4).End(xlDown)).Font.Color = RGB(0, 0, 0)
                 End If
            End If
            
            
        End If
         
        If X = "" Then
            X = Trim(Sheets(1).Cells(K, 2))
            Cells(i, 1).AutoFilter Field:=2, Criteria1:="=*" & X & "*", Operator:=xlOr, Criteria2:=Sheets(1).Cells(K, 2)
            Range(Sheets(2).Cells(2, 1), Sheets(2).Cells(2, 4).End(xlDown)).Font.Color = RGB(0, 0, 0)
            If ActiveSheet.AutoFilter.Range.SpecialCells(xlCellTypeVisible).Areas.Count = 1 Then
                Sheets(2).Cells(2, 3).AutoFilter
                Cells(i, 1).AutoFilter Field:=1, Criteria1:=Sheets(1).Cells(K, 1)
                Range(Sheets(2).Cells(2, 1), Sheets(2).Cells(2, 4).End(xlDown)).Font.Color = RGB(0, 0, 0)
            If ActiveSheet.AutoFilter.Range.SpecialCells(xlCellTypeVisible).Areas.Count = 1 Then
            Exit For
            End If
                Range(Sheets(2).Cells(2, 1), Sheets(2).Cells(2, 4).End(xlDown)).Font.Color = RGB(0, 0, 0)
            End If
        End If
        
    Exit For
    Next i
   
    If G = True Then
        Range(Sheets(2).Cells(1, 1), Sheets(2).Cells(1, 4).End(xlDown)).Copy Sheets(3).Cells(1, 1)
        G = False
    Else
        Range(Sheets(2).Cells(2, 1), Sheets(2).Cells(2, 4).End(xlDown)).Copy Sheets(3).Cells(1, 1).End(xlDown).Offset(1, 0)
    End If
    Sheets(2).Cells(2, 3).AutoFilter

Next K
Sheets(3).Select
Range(Sheets(3).Cells(2, 1), Sheets(3).Cells(2, 4).End(xlDown)).RemoveDuplicates Columns:=1
Range(Sheets(3).Cells(2, 1), Sheets(3).Cells(2, 4).End(xlDown)).Font.Color = RGB(0, 0, 0)
Application.ScreenUpdating = True
End Sub

TOP

回復 38# 軒云熊
如果是 品號 品名 規格 數量 其中一個忘記打 可以試試這個:)
Public Sub 模糊篩選()

Application.ScreenUpdating = False
Range(Sheets(2).Cells(2, 1), Sheets(2).Cells(2, 4).End(xlDown)).Font.Color = RGB(255, 0, 0)
G = True
Sheets(3).Select
Sheets(3).Range(Cells(1, 1), Cells(1, 4).End(xlDown)).Clear
Sheets(2).Select

For K = 2 To Sheets(1).Cells(2, 4).End(xlDown).Row
    X = Trim(Sheets(1).Cells(K, 3))
   
    If Sheets(1).Cells(K, 1) = "" And Sheets(1).Cells(K, 2) = "" And Sheets(1).Cells(K, 3) = "" And Sheets(1).Cells(K, 4) = "" Then
       Exit For
    End If
   
    For i = 2 To Cells(2, 3).End(xlDown).Row '依條件篩選

        If X <> "" And Sheets(1).Cells(K, 3) <> "" Then
            
            Sheets(2).Cells(2, 3).AutoFilter
            Cells(i, 1).AutoFilter Field:=3, Criteria1:="=*" & Mid(X, 1, 8) & "*", Operator:=xlOr, Criteria2:="=" & X & ""
            Range(Sheets(2).Cells(2, 1), Sheets(2).Cells(2, 4).End(xlDown)).Font.Color = RGB(0, 0, 0)

            Cells(i, 1).AutoFilter Field:=3, Criteria1:="=*" & Mid(X, 1, 5) & "*", Operator:=xlOr, Criteria2:="=" & X & ""
            Range(Sheets(2).Cells(2, 1), Sheets(2).Cells(2, 4).End(xlDown)).Font.Color = RGB(0, 0, 0)
            
            If X Like "####[-.]*" Or X Like "####[A-Z]*" Then
                Cells(i, 1).AutoFilter Field:=3, Criteria1:="=*" & Mid(X, 1, 4) & "*", Operator:=xlOr, Criteria2:="=" & X & ""
                Range(Sheets(2).Cells(2, 1), Sheets(2).Cells(2, 4).End(xlDown)).Font.Color = RGB(0, 0, 0)
            End If

            If Sheets(1).Cells(K, 2) <> "" Then
                 If ActiveSheet.AutoFilter.Range.SpecialCells(xlCellTypeVisible).Areas.Count = 1 Then
                     Sheets(2).Cells(2, 3).AutoFilter
                     Cells(i, 1).AutoFilter Field:=2, Criteria1:="=*" & X & "*", Operator:=xlOr, Criteria2:="=" & X & ""
                     Range(Sheets(2).Cells(2, 1), Sheets(2).Cells(2, 4).End(xlDown)).Font.Color = RGB(0, 0, 0)
                     
                     Cells(i, 1).AutoFilter Field:=2, Criteria1:=Sheets(1).Cells(K, 2)
                     Range(Sheets(2).Cells(2, 1), Sheets(2).Cells(2, 4).End(xlDown)).Font.Color = RGB(0, 0, 0)
                 End If
            End If
            
            
        End If
         
        If X = "" Then
            X = Trim(Sheets(1).Cells(K, 2))
            Cells(i, 1).AutoFilter Field:=2, Criteria1:="=*" & X & "*", Operator:=xlOr, Criteria2:=Sheets(1).Cells(K, 2)
            Range(Sheets(2).Cells(2, 1), Sheets(2).Cells(2, 4).End(xlDown)).Font.Color = RGB(0, 0, 0)
            If ActiveSheet.AutoFilter.Range.SpecialCells(xlCellTypeVisible).Areas.Count = 1 Then
                Sheets(2).Cells(2, 3).AutoFilter
                Cells(i, 1).AutoFilter Field:=1, Criteria1:=Sheets(1).Cells(K, 1)
                Range(Sheets(2).Cells(2, 1), Sheets(2).Cells(2, 4).End(xlDown)).Font.Color = RGB(0, 0, 0)
            If ActiveSheet.AutoFilter.Range.SpecialCells(xlCellTypeVisible).Areas.Count = 1 Then
            Exit For
            End If
                Range(Sheets(2).Cells(2, 1), Sheets(2).Cells(2, 4).End(xlDown)).Font.Color = RGB(0, 0, 0)
            End If
        End If
        
    Exit For
    Next i
   
    If G = True Then
        Range(Sheets(2).Cells(1, 1), Sheets(2).Cells(1, 4).End(xlDown)).Copy Sheets(3).Cells(1, 1)
        G = False
    Else
        Range(Sheets(2).Cells(2, 1), Sheets(2).Cells(2, 4).End(xlDown)).Copy Sheets(3).Cells(1, 1).End(xlDown).Offset(1, 0)
    End If
    Sheets(2).Cells(2, 3).AutoFilter

Next K
Sheets(3).Select
Range(Sheets(3).Cells(2, 1), Sheets(3).Cells(2, 4).End(xlDown)).RemoveDuplicates Columns:=1
Range(Sheets(3).Cells(2, 1), Sheets(3).Cells(2, 4).End(xlDown)).Font.Color = RGB(0, 0, 0)
Application.ScreenUpdating = True
End Sub

TOP

回復 38# 軒云熊

程式思路走偏了。

重申題目要點:
不要以品名為基準查詢,重複與多餘資料太多沒有參考價值
規格空白又不能查品名,那還有什麼可以列,所以想到了嗎?








應該去檢查的是你的
If X = "" Then
裡面的迴圈

改完就沒有什麼大問題了,程式核心接近需求,但不知有沒有其他BUG。

沒基礎剛開始學習,但好像看懂你程式再做什麼了,F8好用

算是互相學習吧

TOP

        靜思自在 : 話多不如話少,話少不如話好。
返回列表 上一主題