Board logo

標題: ActiveSheet.Range 可以設定 多個先後得篩顯排序嗎? [打印本頁]
作者: vavashop    時間: 2015-4-28 23:46     標題: ActiveSheet.Range 可以設定 多個先後得篩顯排序嗎?

大大請教一個問題

排序篩選可以設定 先後順序嗎?

ActiveSheet.Range("$A$1:$GZ$5000").AutoFilter Field:=7, Criteria1:="3"
    ActiveSheet.Range("$A$1:$GZ$5000").AutoFilter Field:=6, Criteria1:="3"
作者: koo    時間: 2015-4-29 20:11

依照需求調整
  1. ActiveSheet.Range("$A$1:$GZ$5000").AutoFilter Field:=3, Criteria1:="3"
  2. ActiveSheet.Range("$A$1:$GZ$5000").AutoFilter Field:=6, Criteria1:="3"
  3. ActiveSheet.Range("$A$1:$GZ$5000").AutoFilter Field:=1, Criteria1:="3"
  4. ActiveSheet.Range("$A$1:$GZ$5000").AutoFilter Field:=7, Criteria1:="3"
複製代碼
作者: vavashop    時間: 2015-4-30 16:45

是依照順序游上到下排列嗎？
作者: vavashop    時間: 2015-4-30 16:51

上面這方法 不會 有 順序的篩選
作者: GBKEE    時間: 2015-5-3 08:08

回復 4# vavashop
是這樣嗎?
  1. Sub Ex()
  2.     With ActiveSheet.Range("$A$1:$GZ$5000")
  3.         .AutoFilter Field:=7, Criteria1:="3"
  4.         .AutoFilter Field:=6, Criteria1:="3"
  5.         '排序篩選可以設定 先後順序嗎?
  6.         '是這樣嗎!!
  7.         .Columns(1).Sort KEY1:=.Cells(1), Order1:=xlAscending, Header:=xlYes
  8.         .Columns(2).Sort KEY1:=.Cells(2), Order1:=xlAscending, Header:=xlYes
  9.         .Columns(3).Sort KEY1:=.Cells(3), Order1:=xlAscending, Header:=xlYes
  10.     End With
  11. End Sub
複製代碼
作者: vavashop    時間: 2015-5-6 00:50

嗯嗯∼
大大我有一個疑問∼
我的vba跑完變成200多mb

我想抓篩選出來的資料然後貼上 其他工作表
不知道

我是不是因為下面這一段所以變成越來越大

Range("a2:gz100000").Select
    Selection.Copy

因為資料沒有那麼多 我只需要a2~gz欄位
然後選擇篩選出來的資料複製起來 貼向另一個工作表

第二個問題是現在我很多工作表 "列"都是空白的但號碼都到十萬了
不知道誰可以救我
欄位也可以邦我刪除到a~gz留下來即可嗎？

請各位大大幫忙了

感覺會爆炸的excel
作者: vavashop    時間: 2015-5-6 00:52

另外 大大們∼我b欄位都有資料
所以可以用這一欄 來篩選空白格
作者: Scott090    時間: 2015-5-6 08:12

回復 6# vavashop


    檔案變大，參考 kill row
http://forum.twbts.com/viewthrea ... &from=favorites
作者: vavashop    時間: 2015-5-6 13:23

大大
請問這一段 如何改
Sub 巨集2()
'
' 巨集2 巨集
'

'
  Dim row_s1 As Integer

'檢查工作表1的B欄已有資料行數
    row_s1 = Worksheets(1).Range("B65535").End(xlUp).Row

'B1無資料時，row_s1 =0
    If row_s1 = 1 Then
        If Cells(row_s1, 2) = "" Then
            row_s1 = 0
        End If
    End If
   
   
  
  

   Call a2

Call a1
        
    Range("B2:l9").Select
    Selection.Copy
    Worksheets(1).Select
    Cells(row_s1 + 1, 2).Select
    ActiveSheet.Paste


我想改成 抓出篩選後的資料
Range("B2:l9").Select

i9  資料最後不一定是在這一列
不知道大大可以指點一下嗎？
作者: GBKEE    時間: 2015-5-7 14:40

回復 6# vavashop


   
我是不是因為下面這一段所以變成越來越大
Range("a2:gz100000").Select
    Selection.Copy

試試看 只Copy有資料的儲存格
  1. Sheets("指定的工作表").UsedRange.Columns("a:gz").Offset(1).Copy
複製代碼
作者: vavashop    時間: 2015-5-8 02:00

本帖最後由 GBKEE 於 2015-5-8 08:59 編輯

大大 我遇到一個問題

如果說篩選出來的資料 沒半比資料 巨集會出現錯誤
停留在   ActiveSheet.Paste 跟你說錯誤 那該怎麼修改呢
謝謝

Sub 巨集9()
'
' 巨集9 巨集
'



Dim row_s1 As Integer

'檢查工作表1的B欄已有資料行數
   row_s1 = Worksheets("紀錄-周同軸跌").Range("B65535").End(xlUp).Row

'B1無資料時，row_s1 =0
    If row_s1 = 1 Then
        If Cells(row_s1, 2) = "" Then
            row_s1 = 0
        End If
    End If
      
Sheets("集合").Select
   
' ActiveSheet.Range("$A$1:GZ$55586").AutoFilter Field:=2, Criteria1:= _
' xlFilterToday, Operator:=xlFilterDynamic

ActiveSheet.Range("$A$1:GZ$100000").AutoFilter Field:=18, Criteria1:="<=0"
ActiveSheet.Range("$A$1:GZ$100000").AutoFilter Field:=20, Criteria1:=">=1000"
ActiveSheet.Range("$A$1:GZ$100000").AutoFilter Field:=25, Criteria1:="<=0"
ActiveSheet.Range("$A$1:GZ$100000").AutoFilter Field:=26, Criteria1:="<=-2"
ActiveSheet.Range("$A$1:GZ$100000").AutoFilter Field:=15, Criteria1:="<=0"
ActiveSheet.Range("$A$1:GZ$100000").AutoFilter Field:=7, Criteria1:="<=0"
ActiveSheet.Range("$A$1:GZ$100000").AutoFilter Field:=6, Criteria1:="<=0"
ActiveSheet.Range("$A$1:GZ$100000").AutoFilter Field:=29, Criteria1:=">=50"
ActiveSheet.Range("$A$1:GZ$100000").AutoFilter Field:=30, Criteria1:=">=50"


    Range("a2:gz2").Select '第二欄a2~gz2
    Range(Selection, Selection.End(xlDown)).Select '選擇到最後一欄
    Selection.Copy
    Worksheets("紀錄-adxr跌").Select
    Cells(row_s1 + 1, 2).Select
    ActiveSheet.Paste
     
   Sheets("集合").Select
ActiveSheet.ShowAllData
   
End Sub
作者: GBKEE    時間: 2015-5-8 09:00

回復 11# vavashop
試試看
  1. Option Explicit
  2. Sub 巨集9()
  3.     Dim row_s1 As Integer
  4.     '檢查工作表1的B欄已有資料行數
  5.     With Worksheets("紀錄-周同軸跌")
  6.         row_s1 = .Range("B65535").End(xlUp).Row
  7.         'B1無資料時，row_s1 =0
  8.         If row_s1 = 1 Then
  9.             If .Cells(row_s1, 2) = "" Then
  10.                 row_s1 = 0
  11.             End If
  12.         End If
  13.     End With
  14.     With Sheets("集合")
  15.     ' ActiveSheet.Range("$A$1GZ$55586").AutoFilter Field:=2, Criteria1:= _
  16.     ' xlFilterToday, Operator:=xlFilterDynamic
  17.         With .Range("A1:GZ100000")
  18.             .AutoFilter Field:=18, Criteria1:="<=0"
  19.             .AutoFilter Field:=20, Criteria1:=">=1000"
  20.             .AutoFilter Field:=25, Criteria1:="<=0"
  21.             .AutoFilter Field:=26, Criteria1:="<=-2"
  22.             .AutoFilter Field:=15, Criteria1:="<=0"
  23.             .AutoFilter Field:=7, Criteria1:="<=0"
  24.             .AutoFilter Field:=6, Criteria1:="<=0"
  25.             .AutoFilter Field:=29, Criteria1:=">=50"
  26.             .AutoFilter Field:=30, Criteria1:=">=50"
  27.         End With
  28.          'Range("a2:gz2").Select '第二欄a2~gz2
  29.         .Range(.Range("a2:gz2"), .Range("a2:gz2").End(xlDown)).Copy Worksheets("紀錄-adxr跌").Cells(row_s1 + 1, 2)
  30.         '選擇到最後一欄
  31.         '.Selection.Copy
  32.         'Worksheets("紀錄-adxr跌").Select
  33.         'Worksheets("紀錄-adxr跌").Cells(row_s1 + 1, 1).Select
  34.         'ActiveSheet.Paste
  35.         .Select
  36.         .ShowAllData
  37.     End With
  38. End Sub
複製代碼




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