新手問題,如何篩選後自動將資料由第一欄刪除至最後一欄??? - Excel程式區 - 麻辣家族討論版版

麻辣家族討論版版 » Excel程式區 » 新手問題,如何篩選後自動將資料由第一欄刪除至最後一欄???

返回列表下一主題上一主題發帖

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

超級版主 Rank: 8 Rank: 8

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

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

1^# 跳轉到 »

發表於 2012-1-5 11:18 | 顯示全部帖子

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

超級版主 Rank: 8 Rank: 8

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

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

2^#

發表於 2012-1-9 11:19 | 顯示全部帖子

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

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

複製代碼

超級版主 Rank: 8 Rank: 8

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

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

3^#

發表於 2012-1-10 09:19 | 顯示全部帖子

本帖最後由 GBKEE 於 2012-1-10 11:12 編輯

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

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

複製代碼

Option Explicit
Sub 列高調整()
Dim Rng As Range, Ar(), I
With ActiveSheet
.Cells.EntireRow.AutoFit
Set Rng = .Range("A2:A" & [A2].End(xlDown).Row)
Ar = Rng
For I = 1 To Rng.Count
Ar(I, 1) = Rng(I).RowHeight
Next
Rng.RowHeight = Application.Max(Ar)
End With
End Sub

複製代碼

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

複製代碼

超級版主 Rank: 8 Rank: 8

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

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

4^#

發表於 2012-1-11 20:18 | 顯示全部帖子

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

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

複製代碼

超級版主 Rank: 8 Rank: 8

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

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

5^#

發表於 2012-1-12 16:18 | 顯示全部帖子

回復 9# p6703
請自行套入

Sub Ex()
With Sheet1.Range("A1:A10").EntireRow
.RowHeight = 15
.Font.Size = 9
End With
End Sub

複製代碼

超級版主 Rank: 8 Rank: 8

帖子: 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-14 11:21 | 顯示全部帖子

回復 11# p6703

Option Explicit
Sub Ex()
Dim ChrMax As Integer, R As Range, TheChr As String, A As Integer, Chrx As Integer
ChrMax = 0 '歸零: 紀錄 "換列字元" 的最大數目
For Each R In Sheet1.Range("F1:F10") '依序處裡範圍中的子物件此處是: 儲存格
If InStr(R, Chr(10)) Then '搜尋換列字元: Chr(10)
TheChr = R '儲存格字串指定到 TheChr
A = 0 '歸零: "換列字元"於字串的位置
Chrx = 0 '歸零: 搜尋到"換列字元" 的次數
Do
A = InStr(Mid(TheChr, A + 1), Chr(10)) 'A: "換列字元"於字串的位置
TheChr = Mid(TheChr, A + 1) '重新指定字串 TheChr 從 A+1 到字串尾端
Chrx = Chrx + 1 '搜尋到 "換列字元"的次數 + 1
Loop Until A = 0 '離開迴圈Do Loop 的條件: 搜尋不到"換列字元"
If Chrx > ChrMax Then ChrMax = Chrx '紀錄 "換列字元" 的最大數目
End If
Next
With Sheet1.Range("F1:F10")
.RowHeight = IIf(ChrMax > 0, ChrMax, 1) * 12 '調整列高
.Font.Size = 9 '製訂字體尺寸
End With
End Sub

複製代碼

靜思自在 : 時時好心就是時時好日。

返回列表下一主題上一主題