請各位高手大哥大姐幫忙
我的資料如下
A B C
1 Tom 1 0
2 Jeff 2 2
3 Henry 0 1
4 Jerry 5 5
5 May 1 1
6 Tina 0 0
.
.
..
1000
我要將B欄或C欄值為1的人明複製到另一個工作表，處理後結果如下
A B C
1 Tom 1 0
2 henry 0 1
3 may 1 1
.
.
小弟資料有1000多筆，請幫忙
小弟分2段寫成VBA
第一段OK
Sub 選擇範圍()
Dim i%, j%
Dim ta As Range, tb As Range, tc As Range
With Worksheets(1)
i = Cells(Rows.Count, "a").End(xlUp).Row
j = Range("A1").End(xlToRight).Column
range=(Cells(1, 1), Cells(i, j)).Select
End With
End Sub
第二段OK
Sub 進階篩選與複製()
Dim ta As Range, tb As Range, tc As Range
Set ta = Worksheets(1).Range("a1", "g1310")
Set tb = Worksheets(2).Range("a1", "b2")
Set tc = Worksheets(3).Range("a1")
ta.AdvancedFilter xlFilterCopy, tb, tc
End Sub
我合併兩段程式成為
Sub 進階篩選與複製()
Dim i%, j%
Dim ta As Range, tb As Range, tc As Range
With Worksheets(1)
i = Cells(Rows.Count, "a").End(xlUp).Row
j = Range("A1").End(xlToRight).Column
End With
Set ta = Worksheets(1).Range(Cells(1, 1), Cells(i, j))
Set tb = Worksheets(2).Range("a1", "b2")
Set tc = Worksheets(3).Range("a1")
ta.AdvancedFilter xlFilterCopy, tb, tc
End Sub
結果是出現錯誤，請前被指正!!作者: GBKEE 時間: 2010-12-12 18:40
我是菜鳥無法上傳檔案，謝謝好意。
Sub 進階篩選與複製()
Dim i%, j%
Dim ta As Range, tb As Range, tc As Range
With Worksheets(1)
i = Cells(Rows.Count, "a").End(xlUp).Row
j = Range("A1").End(xlToRight).Column
End With
Set ta = Worksheets(1).Range(Cells(1, 1), Cells(i, j))--問題在這一行，無法拿到I與J值
Set tb = Worksheets(2).Range("a1", "b2")
Set tc = Worksheets(3).Range("a1")
ta.AdvancedFilter xlFilterCopy, tb, tc
End Sub作者: Hsieh 時間: 2010-12-12 22:46
回復 3#jeff2004 上傳檔案是不分等級的
沒有檔案不知你的完整程序為何?
猜測錯誤應是工作表指定的問題
注意WITH區段內的敘述應加入"."
Sub 進階篩選與複製()
Dim i%, j%
Dim ta As Range, tb As Range, tc As Range
With Worksheets(1)
i = .Cells(.Rows.Count, "a").End(xlUp).Row
j = .Range("A1").End(xlToRight).Column
End With
Set ta = Worksheets(1).Range( Worksheets(1).Cells(1, 1), Worksheets(1).Cells(i, j)) '問題在這一行，無法拿到I與J值
Set tb = Worksheets(2).Range("a1", "b2")
Set tc = Worksheets(3).Range("a1")
ta.AdvancedFilter xlFilterCopy, tb, tc
End Sub作者: jeff2004 時間: 2010-12-12 23:11
