新手問題,如何篩選後自動將資料由第一欄刪除至最後一欄???

p6703

小弟近期開始學習VBA，現階段還是使用錄製的方式學習，因資料每次均會有所變更，原錄製時是按定當時該列數（例，上次錄製的列數為11列開始刪除，但下次的資料篩選後的資料由第2列開始時，2~10列的資料就無法刪除了），請問如何設定巨集，使其篩選後由第一符合條件的資料開始刪除至最後一列

另如何設定指定欄位的資料只要符合某條件，即自動將除了該條件外的資料全數刪除???（例：E欄凡有M開頭的資料留著，其餘原資料自動刪除）==>如要多欄位符合設定條件，是否也可依樣作業即可達成???

如於備註欄位填入多列資料，可否依每列固定行高15，自動調整適當的列高（例：如欄位內有4列，即列高為60）

以上問題煩請先進不吝指教，先在此謝謝了:handshake

感謝GBKEE兄即時的告知，已將資料附件如下

Book2.rar (2.29 KB)

下載次數: 18

2012-1-5 11:29

GBKEE

回復 1# p6703
請上傳檔案範例 說明

p6703

這幾天摸索因VBA仍不熟，只用其他方法也先有解決了小弟的問題，說明如下：

1.指定最上層列數由下刪除，指定為第2行一樣可達成，因篩選後只會秀出符合條件的值，由第2列刪除再取消篩選，並不會將原2列未符合條件的資料一併刪除

2.小弟是以庫位篩選，將預計要留除的庫位資料秀於其他工作表，然後以VLOOKUP比對只要非該庫位的就於資料最後一欄位自動秀出"*"，並用篩選將*列數刪除，再用重新排序即可完成留下指定庫位的資料

現只有第3點問題仍無法解決，請各位先進協助是否可依指定欄位的列數自動設定其列高???（一列固定列高15）

GBKEE

回復 3# p6703
一列固定列高15   錄製後可套入

1. Option Explicit
   
2. Sub Ex()   '此程式:請篩選資料後套上
   
3.     Dim Rng As Range, Rng1 As Range, E As Range
   
4.     With ActiveSheet     '作用中工作表
   
5.         If .FilterMode = True Then                            '如果指定活頁簿處於有篩選模式則為 True
   
6.         Set Rng = .UsedRange.SpecialCells(xlCellTypeVisible)  '設定篩選資料範圍
   
7.         '****方式1  顯示所有資料
   
8.         .AutoFilterMode = False                               '屬性為 False  取消工作表 [自動篩選]
   
9.         '如果目前在工作表上顯示有 [自動篩選] 下拉箭號，則此屬性為 True
   
10.         '****方式2  顯示所有資料
    
11.         ' .ShowAllData          'ShowAllData 方法: 使目前篩選清單的所有列均可見。如果正在使用自動篩選，本方法將箭頭變更為 [全部]。
    
12.         '如處於沒有篩選模式:  ShowAllData會有錯誤
    
13.         For Each E In .UsedRange.Rows    '所有資料列
    
14.             If Application.Intersect(E, Rng) Is Nothing Then   '比對資料列: 不在篩選資料範圍內
    
15.                 If Rng1 Is Nothing Then         '未設定Rng1
    
16.                     Set Rng1 = E                '第一次:設定Rng1
    
17.                 Else
    
18.                     Set Rng1 = Union(E, Rng1)   '第一次以後:設定範圍加上(Union)上次 Rng1
    
19.                 End If
    
20.             End If
    
21.         Next
    
22.         Rng1.Delete xlShiftUp                    '刪除不是篩選資料範圍內的Range 下方上移
    
23.         End If
    
24.     End With
    
25. End Sub

複製代碼

p6703

感謝GBKEE兄，但我希望的列高，是會依附件中的F欄位列數去自動調整，例如：第2列有3行，則其行高會自動變為45， 第11列有5行，則其行高為75，依此類推...

另篩選的巨集會再仔細研究一下，先行感謝...^^

GBKEE

回復 5# p6703
看看你是需要哪個  列高調整

1. Sub 列高調整()
   
2.      ActiveSheet.Cells.EntireRow.AutoFit
   
3. End Sub

複製代碼

1. Option Explicit
   
2. Sub 列高調整()
   
3.     Dim Rng As Range, Ar(), I
   
4.     With ActiveSheet
   
5.         .Cells.EntireRow.AutoFit
   
6.         Set Rng = .Range("A2:A" & [A2].End(xlDown).Row)
   
7.         Ar = Rng
   
8.         For I = 1 To Rng.Count
   
9.             Ar(I, 1) = Rng(I).RowHeight
   
10.         Next
    
11.         Rng.RowHeight = Application.Max(Ar)
    
12.     End With
    
13. End Sub

複製代碼

1. Option Explicit
   
2. Sub Ex()   '此程式:請篩選資料後套上
   
3.     Dim Rng As Range, Rng1 As Range, E As Range
   
4.     With ActiveSheet     '作用中工作表
   
5.         If .FilterMode = True Then                            '如果指定活頁簿處於有篩選模式則為 True
   
6.         Set Rng = .UsedRange.SpecialCells(xlCellTypeVisible)  '設定篩選資料範圍
   
7.         '****方式1  顯示所有資料
   
8.         .AutoFilterMode = False                               '屬性為 False  取消工作表 [自動篩選]
   
9.         '如果目前在工作表上顯示有 [自動篩選] 下拉箭號，則此屬性為 True
   
10.         '****方式2  顯示所有資料
    
11.         ' .ShowAllData          'ShowAllData 方法: 使目前篩選清單的所有列均可見。如果正在使用自動篩選，本方法將箭頭變更為 [全部]。
    
12.         '如處於沒有篩選模式:  ShowAllData會有錯誤
    
13.         For Each E In .UsedRange.Rows    '所有資料列
    
14.             If Application.Intersect(E, Rng) Is Nothing Then   '比對資料列: 不在篩選資料範圍內
    
15.                 If Rng1 Is Nothing Then         '未設定Rng1
    
16.                     Set Rng1 = E                '第一次:設定Rng1
    
17.                 Else
    
18.                     Set Rng1 = Union(E, Rng1)   '第一次以後:設定範圍加上(Union)上次 Rng1
    
19.                 End If
    
20.             End If
    
21.         Next
    
22.         Rng1.Delete xlShiftUp                    '刪除不是篩選資料範圍內的Range 下方上移
    
23.         End If
    
24.     End With
    
25.     列高調整         '
    
26. End Sub

複製代碼

p6703

感謝GBKEE兄，小弟仍不明巨集用法，特再請問：

第二種巨集執行後行高變為36，且好像每個報表執行起來行高均不同，且於巨集中未見有指定以F欄位行高判定，不知是否可再加以解釋巨集的用法???

GBKEE

回復 7# p6703
且好像每個報表執行起來行高均不同     當然是不一樣   你沒說有要執行一個以上的報表啊

1. Option Explicit     'Option Explicit 陳述式 在模組層次中強迫每個在模組裏的變數都必須明確的宣告。
   
2. Sub 列高調整()
   
3.     Dim Rng As Range, Ar(), i As Integer
   
4.     With ActiveSheet                 '作用中的工作表
   
5.         .Cells.EntireRow.AutoFit     'ActiveSheet.Cells : ActiveSheet的儲存格
   
6.         Set Rng = .Range("A2:A" & [A2].End(xlDown).Row)
   
7.         'a2 到 a2.End(xlDown)(往下到最後的資料).Row(列號)
   
8.         '可改為F欄     .Range("F2:F" & [F2].End(xlDown).Row)
   
9.         Ar = Rng                     'Ar陣列元素=Rng的(內容)數量: Ar陣列元素=Range 是為二維陣列
   
10.         For i = 1 To Rng.Count
    
11.             Ar(i, 1) = Rng(i).RowHeight
    
12.             ' Ar(i, 1)        : Ar(i, 第2維素) Ar陣列第2維素=1
    
13.             'Rng(i).RowHeight : Rng的(i)的儲存格之RowHeight(列高)
    
14.         Next
    
15.         Rng.RowHeight = Application.Max(Ar) '取得Ar陣列元素中的最大值
    
16.     End With
    
17. End Sub

複製代碼

p6703

呵呵..感謝GBKEE兄啦,我只是想說往後可能還可運用,按以上巨集執行後應可符合要求了,但小弟還是有一問題,雖然已可按欄位要求自動設定列高,但發現是按預設的列高12去調整的,因小弟使用的習慣字體大小為9時,適當的列高為15,這是否可再經由巨集調整呢???

GBKEE

回復 9# p6703
請自行套入

1. Sub Ex()
   
2.     With Sheet1.Range("A1:A10").EntireRow   
   
3.         .RowHeight = 15
   
4.         .Font.Size = 9
   
5.     End With
   
6. End Sub

複製代碼