准提部林

回復 10# 准提部林


For j = 4 To .Cells(Rows.Count, 1).End(xlUp).Row

４為查詢資料〔來源〕工作表〔資料明細〕的〔起始列〕，與上方的４不相關，
一個是查詢表，一個是資料表，只是剛好都從第４列開始，
＿＿不同工作表必須有固定的表格結構，否則容易出錯～～

其它大致都對～～

sss1159

回復 11# 准提部林

剛實際操作一遍，實在太厲害了!!!!
我後來在工作表1 新增了一個排序的功能(錄製巨集)
還沒塞選時 是能正常排序的
但我一但塞選時 再排序 EXCEL就當掉了

再麻煩您了 感謝感謝
附上語法

Sub 巨集3()
'
' 巨集3 巨集
'

'
    Range("E4:E10000").Select
    ActiveWorkbook.Worksheets("工作表1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("工作表1").Sort.SortFields.Add Key:=Range("E4:E10000"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("工作表1").Sort
        .SetRange Range("A3:E10000")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("E4").Select
    Selection.End(xlDown).Select
End Sub

設1萬 是怕日後資料越來越多 XD"

准提部林

回復 12# sss1159

排序程式碼最上方加入：
ActiveSheet.AutoFilterMode = False

注意：篩選狀態時，若不先解除篩選，任何操作都可能造成無法彌補的錯誤（尤其是已執行了儲存結果）

sss1159

回復 13# 准提部林

注意：篩選狀態時，若不先解除篩選，任何操作都可能造成無法彌補的錯誤（尤其是已執行了儲存結果）

再測試時，就當了好幾次XD"

加了那段後，就不會當了，但是塞選會被取消掉，請問有辦法塞選完，再排序塞選的資料嗎?

不好意思，一直麻煩您:dizzy:
附上檔案給您看

GBKEE

回復 14# sss1159

試試看 2003的排序

1. Option Explicit
   
2. Sub 篩選()
   
3.     Dim X$
   
4.     X = Application.InputBox("請輸入篩選關鍵字")
   
5.     If X = "" Or X = "False" Then Exit Sub   '
   
6.     With Sheets("工作表1").[A3]  '
   
7.         .Parent.AutoFilterMode = False
   
8.         .AutoFilter Field:=1, Criteria1:="*" & X & "*"
   
9.         If .End(xlDown).Row = Rows.Count Then MsgBox "找不到資料!!": Exit Sub
   
10.         .CurrentRegion.Sort Key1:=.Range("A2"), Order1:=xlAscending, Key2:=.Range("B2"), Order2:=xlAscending, Header:=xlYes
    
11.     End With
    
12. End Sub

複製代碼

sss1159

回復 15# GBKEE

您好，使用了您的方法還是會跑出原本的資料
我附個示意圖=)

在麻煩了><

GBKEE

回復 16# sss1159
[新增日期]  在E欄(第5欄)修改如下:

1. .CurrentRegion.Sort Key1:=.Range("A2"), Order1:=xlAscending, Key2:=.Range("E2"), Order2:=xlAscending, Header:=xlYes

複製代碼

1. Sub 篩選()
   
2.     Dim X$
   
3.     X = Application.InputBox("請輸入篩選關鍵字")
   
4.     If X = "" Or X = "False" Then Exit Sub   '
   
5.     With Sheets("工作表1").[A3]  '
   
6.         .Parent.AutoFilterMode = False
   
7.         '篩選前也可所有資料 [新增日期]排序
   
8.         '.CurrentRegion.Sort Key1:=.Range("E2"), Order1:=xlAscending, Header:=xlYes
   
9.         .AutoFilter Field:=1, Criteria1:="*" & X & "*"
   
10.         If .End(xlDown).Row = Rows.Count Then MsgBox "找不到資料!!": Exit Sub
    
11.         '只對篩選後資料[新增日期]排序
    
12.         .CurrentRegion.Sort Key1:=.Range("E2"), Order1:=xlAscending, Header:=xlYes
    
13.     End With
    
14. End Sub

複製代碼

准提部林

回復 14# sss1159

Sub 排序()
Dim R&
R = [工作表1!A1].Cells(Rows.Count, 1).End(xlUp).Row
If R < 4 Then Exit Sub
With [工作表1!A3:E3].Resize(R - 2)
　　　.Select　'這可以刪掉　
　　　.Sort Key1:=.Item(5), Order1:=xlAscending, Header:=xlYes, _
　　　　　　OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End With
End Sub

.Item(5)　即是Ｅ欄的標題〔新增日期〕！
再提醒：〔篩選〕狀態中，儘量不做〔排序〕，也不從它處貼資料進來，會造成資料錯亂

sss1159

謝謝 兩位版主抽空回覆
學到了很多，疑問也都解決了，
我再試著練習看看，非常感謝

sss1159

回復 17# GBKEE

馬上就有問題了....囧
由於上方註解需要多一行，變成標題欄在A4~E6
將 GBKEE大的語法稍做修正

Sub 篩選123()
    Dim X$
    X = Application.InputBox("請輸入篩選關鍵字")
    If X = "" Or X = "False" Then Exit Sub
    With Sheets("工作表3").[A4]  '
        .Parent.AutoFilterMode = False
        '篩選前也可所有資料 [新增日期]排序
        '.CurrentRegion.Sort Key1:=.Range("E2"), Order1:=xlAscending, Header:=xlYes
        .AutoFilter Field:=1, Criteria1:="*" & X & "*"
        If .End(xlDown).Row = Rows.Count Then MsgBox "找不到資料!!": Exit Sub
        '只對篩選後資料[新增日期]排序
        .CurrentRegion.Sort Key1:=.Range("C4"), Order1:=xlAscending, Header:=xlYes
    End With
End Sub

塞選後確出現標題也一併排序跑到最下面去了，導致版面亂了...
再麻煩了多次叨擾...