2017-03-18 37 views
1
Sub filterData() 
    Dim filterCriteria As String 
    x = 1 
    Do While Not IsEmpty(filterCriteria) 
     filterCriteria = (Sheets("Lists").Cells(x, 2)) 
     Sheets(filterCriteria).Select 
     Sheets(filterCriteria).Cells.Clear 

     Range("A1") = "Date" 
     Range("B1") = "Item" 
     Range("C1") = "Category" 
     Range("D1") = "Quantity" 
     Range("E1") = "Rate" 
     Range("F1") = "Total" 
     Range("A1:F1").Font.Bold = True 
     Range("A1:F1").Font.ColorIndex = 5 
     Sheets("BookEntry").Select 
     Dim lastRow As Long 

     lastRow = Sheets("BookEntry").Cells.Find(What:="*", _ 
     After:=Range("A1"), _ 
     LookAt:=xlPart, _ 
     LookIn:=xlFormulas, _ 
     SearchOrder:=xlByRows, _ 
     SearchDirection:=xlPrevious, _ 
     MatchCase:=False).row 
     Dim lastColumn As Long 

     lastColumn = Sheets("BookEntry").Cells.Find(What:="*", _ 
     After:=Range("A1"), _ 
     LookAt:=xlPart, _ 
     LookIn:=xlFormulas, _ 
     SearchOrder:=xlByColumns, _ 
     SearchDirection:=xlPrevious, _ 
     MatchCase:=False).Column 

     Sheets("BookEntry").Range(Cells(1, 1), Cells(lastRow, lastColumn)).AutoFilter Field:=3, Criteria1:=filterCriteria 
     Sheets("BookEntry").Range(Cells(2, 1), Cells(lastRow, lastColumn)).Copy 
     Sheets(filterCriteria).Select 
     erow = Sheets(filterCriteria).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).row 

     Sheets(filterCriteria).Paste Destination:=Worksheets(filterCriteria).Rows(erow) 
     Sheets("BookEntry").Select 
     Sheets("BookEntry").Range(Cells(1, 1), Cells(lastRow, lastColumn)).AutoFilter Field:=3 
     ActiveWorkbook.Save 
     x = x + 1 
    Loop 
End Sub 

回答

2

你犯了兩個錯誤。

1-您在分配前檢查filterCriteria

2-若要檢查空的filterCriteria,應該檢查字符串是否爲Len(Trim(filterCriteria)) > 0,否則應該聲明該變量爲變體,因爲IsEmpty適用於變體。但字符串選項更好。

改變循環的結構到這一點:

x = 1 
Dim filterCriteria As String 
filterCriteria = Sheets("Lists").Cells(x, 2).value 

Do While Len(Trim(filterCriteria)) > 0 
    ... 
    ... 
    x = x + 1 
    filterCriteria = Sheets("Lists").Cells(x, 2).value 
Loop 

也儘量get rid of those .Select stuff

+0

哇,這真是太快了!感謝您的幫助A.S.H.我會盡我所能來實施你的建議。如果我能夠實現這個目標,我該如何標記這個解決方案? – user252391

+0

@ user252391歡迎您。 –

+0

太棒了!這是完美的。我有點明白你的意思,但如果你可以評論我的原代碼,這對我學習會非常有幫助。此外,我不知道如何刪除.Select的東西。我的代碼仍然可以運行嗎? – user252391

相關問題