不得不說,你這個(gè)問題有點(diǎn)難,其實(shí)也不是難,是惡心。對(duì)于一般的沒有VBA基礎(chǔ)的人,處理這個(gè)問題就是通過一步步繁復(fù)的操作來實(shí)現(xiàn)。 如果說通過篩選去找,數(shù)據(jù)量大的話,這個(gè)事無疑會(huì)惡心死人。 我看這個(gè)問題在這有一段時(shí)間了,但是也沒人給出靠譜的回答,所以特地寫了一段代碼。經(jīng)測試,完全沒有問題。 而且,這個(gè)問題提的也很模糊,不太方便給出針對(duì)性的做法 對(duì)于寫VBA代碼來說沒有說清楚的地方有以下幾處:
以上情況都是編寫VBA代碼需要考慮的地方 我這里呢,根據(jù)給出的模糊問題,簡單的寫了一個(gè)大概能用的宏命令 先說一下我的思路:
下圖是我做的實(shí)例,有三個(gè)Sheet表,每個(gè)表格中存在標(biāo)注了顏色的行,或單元格: Sheet1,標(biāo)題行標(biāo)注顏色,數(shù)據(jù)中整行包含不同顏色 Sheet2,標(biāo)題行標(biāo)注顏色,數(shù)據(jù)中非整行包含不同顏色 Sheet3,標(biāo)題行未標(biāo)注顏色,數(shù)據(jù)中非整行包含不同顏色 VBA編輯器打開方法,快捷鍵:Alt+F11,工程區(qū),插入,模塊 VBA代碼圖示(源碼占用篇幅較大,我放到最后了): 其中 Sub Clear():用于清除未標(biāo)注顏色的非空單元格 Sub DeleteEmptyRows():用于刪除空行 Sub DeleteEmptyColumns():用于刪除空列 代碼執(zhí)行過程中,只執(zhí)行一個(gè)工程,但通過Sub Clear()工程,調(diào)用了Sub DeleteEmptyRows()和Sub DeleteEmptyColumns() 我們來看一下執(zhí)行代碼的效果: 代碼執(zhí)行時(shí),為了看效果,我屏蔽了兩條返回sheet1的代碼 從動(dòng)圖可以看到,代碼執(zhí)行的很快,也達(dá)到了我們的目
我再一步一步執(zhí)行代碼,給大家看一下Excel都干了些什么(由于多個(gè)sheet處理機(jī)制一樣,這里只錄制了兩個(gè)sheet的處理過程慢放): 通過慢放,大家應(yīng)該能看出,代碼真的是很蠢的,它也是一個(gè)一個(gè)的單元格去刪除,然后再去刪除行。 需要注意的是,如果表格中存在空的sheet,vba會(huì)給出一個(gè)提示,如果空表夾雜在有數(shù)據(jù)的表格中間,那么代碼運(yùn)行到空表的時(shí)候會(huì)退出,直接給出提示,不再向下運(yùn)行。 提示如下: sheet4為一個(gè)空的表格 對(duì)于宏,你也可以再Excel中插入一個(gè)控件,指定到所編寫的宏,之后,點(diǎn)擊控件即可執(zhí)行宏了。操作方法如下: ok,就這么多吧,代碼我寫在下邊了,沒有寫注釋,如果有感興趣的朋友可以自己去研究優(yōu)化一下,或者有什么疑問,評(píng)論或私信聯(lián)系我即可: 橫線中間為VBA代碼: -------------------------------------- Sub Clear() Dim rng As Range, i As Integer For i = 1 To ActiveWorkbook.Worksheets.Count ActiveWorkbook.Worksheets(i).Select For Each rng In ActiveSheet.UsedRange.SpecialCells(2) On Error GoTo Skip If rng.Interior.ColorIndex = xlNone Then rng.Clear End If Next Call DeleteEmptyRows Call DeleteEmptyColumns Next ActiveWorkbook.Worksheets(1).Select Exit Sub Skip: ActiveWorkbook.Worksheets(1).Select MsgBox '已經(jīng)沒有未標(biāo)記顏色的非空單元格' End Sub Sub DeleteEmptyRows() Dim LastRow As Integer, r As Integer LastRow = ActiveSheet.UsedRange.Rows.Count LastRow = LastRow + ActiveSheet.UsedRange.Row - 1 For r = LastRow To 1 Step -1 If WorksheetFunction.CountA(Rows(r)) = 0 Then Rows(r).Delete End If Next r End Sub Sub DeleteEmptyColumns() Dim LastColumn As Integer, c As Integer LastColumn = ActiveSheet.UsedRange.Columns.Count LastColumn = LastColumn + ActiveSheet.UsedRange.Column For c = LastColumn To 1 Step -1 If WorksheetFunction.CountA(Columns(c)) = 0 Then Columns(c).Delete End If Next c End Sub -------------------------------------- |
|