麻辣家族討論版版 - Powered by Discuz! Board

標題: 新手問題,如何篩選後自動將資料由第一欄刪除至最後一欄??? [打印本頁]

作者: p6703 時間: 2012-1-5 10:43 標題: 新手問題,如何篩選後自動將資料由第一欄刪除至最後一欄???

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

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

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

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

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

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

[attach]9070[/attach]

作者: GBKEE 時間: 2012-1-5 11:18

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

作者: p6703 時間: 2012-1-9 09:30

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

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

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

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

作者: GBKEE 時間: 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

複製代碼

作者: p6703 時間: 2012-1-9 16:48

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

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

作者: GBKEE 時間: 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

複製代碼

作者: p6703 時間: 2012-1-11 18:46

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

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

作者: GBKEE 時間: 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

複製代碼

作者: p6703 時間: 2012-1-11 21:39

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

作者: GBKEE 時間: 2012-1-12 16:18

回復 9# p6703
請自行套入

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

複製代碼

作者: p6703 時間: 2012-1-13 18:06

GBKEE兄，如按以上巨集，那執行後每列調整成15行高，非小弟需求
如按EXCEL自動調整的功能，如果該行欄位最多有7列，則按字體9其行高即為7 X 12=84，但列印會有一些字體被裁切，調整是以行高15為佳

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

作者: GBKEE 時間: 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

複製代碼

作者: p6703 時間: 2012-1-18 08:43

GBKEE兄,按以上巨集套用原我附件,仍無法達成小弟要求的

小弟上網找了一些相關的討論,以下可達成一部份的要求(就是不斷行,以每行26字計算,超過即直接無條件進位一列)
以下巨集是一次判定200列,請問如何巨集自動判斷資料行數,自行可以按有資料的列數去設定欄高呢???
但如果按附件中F欄位的話則此仍無法達成(因依編號斷行,有時一列可能10幾個字)

Sub 行高()
Dim i As Integer
For i = 1 To 200
If (Len(Cells(i, 12)) / 26) > 1 Then
Y = Application.WorksheetFunction.RoundUp(Len(Cells(i, 12)) / 26, 0)
Rows(i).RowHeight = 15 * Y
End If
Next
End Sub

複製代碼

作者: Hsieh 時間: 2012-1-18 09:16

回復 11# p6703

Sub ex()
Dim A As Range, Ar()
For Each A In Range("A1").CurrentRegion.Columns(1).Cells
If A.EntireRow.Hidden = False Then '找出非隱藏列
ReDim Preserve Ar(s)
Ar(s) = A.Resize(, 6).Value
s = s + 1
End If
Next
Sheet1.ShowAllData '顯示全部資料
Range("A1").CurrentRegion.ClearContents '清除原資料
[A1].Resize(s, 6) = Application.Transpose(Application.Transpose(Ar)) '寫入資料
For Each A In Range([F2], Cells(Rows.Count, 6).End(xlUp))
k = Len(A) - Len(Replace(A, Chr(10), "")) + 1 '計算有幾列文字
A.RowHeight = 15 * k '設定列高
Next
End Sub

複製代碼

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