12
返回列表 上一主題 發帖

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

p6703

帖子
134 
主題
27 
精華
0 
積分
168 
點名
0  
作業系統
WINXP 
軟體版本
EXCEL 2003 
閱讀權限
20 
性別
男 
來自
雲林 
註冊時間
2010-10-6 
最後登錄
2018-5-13 

論壇贊助勳章
1# 跳轉到 » 正序看帖
打印
tT
發表於 2012-1-5 10:43 | 只看該作者

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

本帖最後由 p6703 於 2012-1-5 11:33 編輯

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

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

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

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

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

Book2.rar (2.29 KB)
收藏 分享

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
254  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2024-11-23 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
14#
發表於 2012-1-18 09:16 | 只看該作者
回復 11# p6703
  1. Sub ex()
  2. Dim A As Range, Ar()
  3. For Each A In Range("A1").CurrentRegion.Columns(1).Cells
  4.   If A.EntireRow.Hidden = False Then '找出非隱藏列
  5.     ReDim Preserve Ar(s)
  6.     Ar(s) = A.Resize(, 6).Value
  7.     s = s + 1
  8.   End If
  9. Next
  10. Sheet1.ShowAllData '顯示全部資料
  11. Range("A1").CurrentRegion.ClearContents '清除原資料
  12. [A1].Resize(s, 6) = Application.Transpose(Application.Transpose(Ar)) '寫入資料
  13. For Each A In Range([F2], Cells(Rows.Count, 6).End(xlUp))
  14. k = Len(A) - Len(Replace(A, Chr(10), "")) + 1 '計算有幾列文字
  15. A.RowHeight = 15 * k '設定列高
  16. Next
  17. End Sub
複製代碼
學海無涯_不恥下問

TOP

p6703

帖子
134 
主題
27 
精華
0 
積分
168 
點名
0  
作業系統
WINXP 
軟體版本
EXCEL 2003 
閱讀權限
20 
性別
男 
來自
雲林 
註冊時間
2010-10-6 
最後登錄
2018-5-13 

論壇贊助勳章
13#
發表於 2012-1-18 08:43 | 只看該作者
GBKEE兄,按以上巨集套用原我附件,仍無法達成小弟要求的

小弟上網找了一些相關的討論,以下可達成一部份的要求(就是不斷行,以每行26字計算,超過即直接無條件進位一列)
以下巨集是一次判定200列,請問如何巨集自動判斷資料行數,自行可以按有資料的列數去設定欄高呢???
但如果按附件中F欄位的話則此仍無法達成(因依編號斷行,有時一列可能10幾個字)
  1. Sub 行高()
  2. Dim i As Integer
  3. For i = 1 To 200
  4. If (Len(Cells(i, 12)) / 26) > 1 Then
  5. Y = Application.WorksheetFunction.RoundUp(Len(Cells(i, 12)) / 26, 0)
  6. Rows(i).RowHeight = 15 * Y
  7. End If
  8. Next
  9. End Sub
複製代碼

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
12#
發表於 2012-1-14 11:21 | 只看該作者
回復 11# p6703
  1. Option Explicit
  2. Sub Ex()
  3.     Dim ChrMax As Integer, R As Range, TheChr As String, A As Integer, Chrx As Integer
  4.     ChrMax = 0                                '歸零:  紀錄 "換列字元" 的最大數目
  5.     For Each R In Sheet1.Range("F1:F10")      '依序處裡範圍中的子物件 此處是: 儲存格
  6.         If InStr(R, Chr(10)) Then             '搜尋換列字元: Chr(10)
  7.             TheChr = R                        '儲存格字串指定到 TheChr
  8.             A = 0                             '歸零:  "換列字元"於 字串的位置
  9.             Chrx = 0                          '歸零:  搜尋到"換列字元" 的次數
  10.             Do
  11.                 A = InStr(Mid(TheChr, A + 1), Chr(10))   'A: "換列字元"於 字串的位置
  12.                 TheChr = Mid(TheChr, A + 1)              '重新指定字串 TheChr 從 A+1 到字串尾端
  13.                 Chrx = Chrx + 1                          '搜尋到 "換列字元"的次數 + 1
  14.             Loop Until A = 0                             '離開迴圈Do Loop 的條件:  搜尋不到"換列字元"
  15.             If Chrx > ChrMax Then ChrMax = Chrx          '紀錄 "換列字元" 的最大數目
  16.         End If
  17.     Next
  18.     With Sheet1.Range("F1:F10")
  19.         .RowHeight = IIf(ChrMax > 0, ChrMax, 1) * 12     '調整列高
  20.         .Font.Size = 9                                   '製訂字體尺寸
  21.     End With
  22. End Sub
複製代碼

TOP

p6703

帖子
134 
主題
27 
精華
0 
積分
168 
點名
0  
作業系統
WINXP 
軟體版本
EXCEL 2003 
閱讀權限
20 
性別
男 
來自
雲林 
註冊時間
2010-10-6 
最後登錄
2018-5-13 

論壇贊助勳章
11#
發表於 2012-1-13 18:06 | 只看該作者
GBKEE兄，如按以上巨集，那執行後每列調整成15行高，非小弟需求
如按EXCEL自動調整的功能，如果該行欄位最多有7列，則按字體9其行高即為7 X 12=84，但列印會有一些字體被裁切，調整是以行高15為佳

故小弟是希望可按巨集將原EXCEL的預計行高12--->15

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
10#
發表於 2012-1-12 16:18 | 只看該作者
回復 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
複製代碼

TOP

p6703

帖子
134 
主題
27 
精華
0 
積分
168 
點名
0  
作業系統
WINXP 
軟體版本
EXCEL 2003 
閱讀權限
20 
性別
男 
來自
雲林 
註冊時間
2010-10-6 
最後登錄
2018-5-13 

論壇贊助勳章
9#
發表於 2012-1-11 21:39 | 只看該作者
呵呵..感謝GBKEE兄啦,我只是想說往後可能還可運用,按以上巨集執行後應可符合要求了,但小弟還是有一問題,雖然已可按欄位要求自動設定列高,但發現是按預設的列高12去調整的,因小弟使用的習慣字體大小為9時,適當的列高為15,這是否可再經由巨集調整呢???

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
8#
發表於 2012-1-11 20:18 | 只看該作者
回復 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
複製代碼

TOP

p6703

帖子
134 
主題
27 
精華
0 
積分
168 
點名
0  
作業系統
WINXP 
軟體版本
EXCEL 2003 
閱讀權限
20 
性別
男 
來自
雲林 
註冊時間
2010-10-6 
最後登錄
2018-5-13 

論壇贊助勳章
7#
發表於 2012-1-11 18:46 | 只看該作者
感謝GBKEE兄，小弟仍不明巨集用法，特再請問：

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

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
6#
發表於 2012-1-10 09:19 | 只看該作者
本帖最後由 GBKEE 於 2012-1-10 11:12 編輯

回復 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
複製代碼

TOP

        靜思自在 : 虛空有盡．我願無窮，發願容易行願難。
12
返回列表 上一主題