Board logo

標題: [發問] 篩選資料問題? [打印本頁]
作者: idsmchow    時間: 2011-12-27 00:12     標題: 篩選資料問題?

本帖最後由 idsmchow 於 2011-12-27 00:14 編輯

請問如何修改以下的巨集??

Private Sub CommandButton1_Click()
Dim eachsht As Worksheet, eachrng As Range, tmpTbl As Range
For Each eachsht In Worksheets
If eachsht.Name <> "Statement" Then
Set eachrng = Sheets("Statement").Range("a65536").End(xlUp).Offset(1)
Set tmpTbl = eachsht.Range("a2").CurrentRegion
eachsht.Range("a2").CurrentRegion.AutoFilter Field:=3, Criteria1:=Sheets("Statement").Range("G2"), Operator:=xlAnd
tmpTbl.Rows("2:" & tmpTbl.Rows.Count).Copy eachrng
End If
Next
End Sub

當乎合條件的要求, 例如 "AA Ltd" 條件都在 Jan , Feb. Mar Sheet - 資料表出現的話, 這巨集就能正確篩選所需的資料及複製到Statement Sheet.

但條件不乎合資料表的話 例如 "EE Ltd" 這巨集就會將所有沒有關係的資料一併轉寫.

問題是否出於 ' tmpTbl.Rows("2:" & tmpTbl.Rows.Count)' 這一句上?

請問如何修正?

謝謝
作者: register313    時間: 2011-12-27 13:53

回復 1# idsmchow


     tmpTbl.Rows("2:" & tmpTbl.Rows.Count +1)   
     多複製一列空白列
作者: GBKEE    時間: 2011-12-27 15:50

回復 1# idsmchow
  1. Private Sub CommandButton1_Click()
  2.     Dim eachsht As Worksheet, eachrng As Range
  3.     For Each eachsht In Worksheets
  4.         With eachsht
  5.             If .Name <> "Statement" Then
  6.                 .Range("a1").AutoFilter Field:=3, Criteria1:=Sheets("Statement").Range("G2"), Operator:=xlAnd
  7.                 If .Range("a" & Rows.Count).End(xlUp).Row > 1 Then '有篩選到所需的資料
  8.                     Set eachrng = Sheets("Statement").Range("a" & Rows.Count).End(xlUp).Offset(1)
  9.                     .Rows("2:" & .Range("a" & Rows.Count).End(xlUp).Row).Copy eachrng
  10.                 End If
  11.                 .Range("a2").CurrentRegion.AutoFilter              '沒有指定準則->顯示全部資料
  12.             End If
  13.         End With
  14.     Next
  15. End Sub
複製代碼
作者: idsmchow    時間: 2011-12-27 23:48

問題已解決, 謝謝各位的回覆

但register313 的答案
tmpTbl.Rows("2:" & tmpTbl.Rows.Count +1)
好像不正確
作者: register313    時間: 2011-12-28 00:32

本帖最後由 register313 於 2011-12-28 00:36 編輯

回復 4# idsmchow


程式是依樓主之意作最少之修正
也許不完美
但如何不正確 請說明清楚 讓我知道問題
與GBKEE版大程式執行之結果是相同的
[attach]8935[/attach]
作者: GBKEE    時間: 2011-12-28 15:23

回復 5# register313
沒錯.是一樣的效果,差別是你多複製空白的一列.
如果資料庫的資料是連續到工作表的最後一列,你我的程式都會出錯的
作者: register313    時間: 2011-12-28 15:32

回復 6# GBKEE
   
感謝GBKEE版大一直給予指導
作者: Hsieh    時間: 2011-12-28 17:40

回復 1# idsmchow
  1. Private Sub CommandButton1_Click()
  2. Dim Sh As Worksheet, Rng As Range
  3. For Each Sh In Sheets
  4. If Sh.Name <> "Statement" Then   '略過Statement工作表
  5. With Sh
  6.   If .AutoFilter.Filters(3).On Then .ShowAllData   '如果C欄沒有被篩選
  7.      .Range("A1").CurrentRegion.AutoFilter 3, Sheets("Statement").Range("G2"), xlAnd   '就以C欄篩選
  8.      Set Rng = Intersect(.[A2:D65536], .AutoFilter.Range.SpecialCells(xlCellTypeVisible))    'A:D蘭蒂2列以下與篩選結果的可見儲存格交集部分
  9.      If Not Rng Is Nothing Then Rng.Copy Sheets("Statement").Range("A65536").End(xlUp).Offset(1, 0)  '複製
  10. End With
  11. End If
  12. Next
  13. End Su
複製代碼
作者: idsmchow    時間: 2011-12-28 23:44

回復 5# register313


    Hi register313,

你的解答是正確, 只是自己改動了一些格式, 而導致出現問題.
本人是初學者, 剛剛買了幾本書自學, 日後請多多指教.

對於日前的說法, 請多多包涵

再次謝謝
作者: idsmchow    時間: 2011-12-29 00:00

回復 8# Hsieh


    超級版主　所寫的巨集有部份語法, 在我購買的書本中沒有提及過。例如On Then.　Intersect.　比較高深

對於我（初學者）來說，　需要時間理解。

謝謝大家回覆。
作者: idsmchow    時間: 2011-12-29 00:13

我自己也從書本中，將一些巨集修改，寫了一個巨集，不知是否正確。
希望大家修改，給一些意見

Sub Click()
Dim eachsht As Worksheet, eachrng As Range, tmpTbl As Range
Dim myFld As Integer, I As Integer, Q As Range

For Each eachsht In Worksheets
If eachsht.Name <> "Statement" Then

Set eachrng = Sheets("Statement").Range("a65536").End(xlUp).Offset(1)
Set tmpTbl = eachsht.Range("a2").CurrentRegion
Set Q = Sheets("Statement").Range("G2")
myFld = 3

For I = 2 To 180
If tmpTbl.Cells(I, myFld).Value = Q Then
eachsht.Range("a2").CurrentRegion.AutoFilter Field:=3, Criteria1:=Q, Operator:=xlAnd
tmpTbl.Rows("2:" & tmpTbl.Rows.Count).Copy eachrng
End If
Next

End If
Next

End Sub



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)