返回列表 上一主題 發帖

[發問] vba特定格式刪除

[發問] vba特定格式刪除

如何把清冊中的特定格式刪除(標是顏色部份),在資料往上遞補,因為每一階段的資料有所不同,所以表格上的每列資料不相同(沒有固定),請老師幫忙,謝謝!
附檔解題: 20160603.rar (21.62 KB)

Sub test()
    Application.ScreenUpdating = False
    With Sheets("Sheet1")
        er = .[J65536].End(3).Row
        For r = er To 1 Step -1
            If .Cells(r, 1).Interior.ColorIndex = 4 Then Rows(r).Delete
        Next r
    End With
    Application.ScreenUpdating = True
End Sub

TOP

回復 2# Kubi


    感謝Kubi大大的回答,刪除的很整確,但 再拜託一下,還有另一種格式,所以程式沒法用,另一個問題在SHEEET2 ,刪除的方式,根SHEET1一樣,附檔: 20160603AA.rar (29.82 KB)
    謝謝!

TOP

Sub test2()
    Application.ScreenUpdating = False
    With Sheets("Sheet2")
        er = .[I65536].End(3).Row
        For r = er To 1 Step -1
            If .Cells(r, 10).Interior.ColorIndex = 4 Then Rows(r).Delete
        Next r
    End With
    Application.ScreenUpdating = True
End Sub

TOP

回復 3# man65boy

試試看
  1. Option Explicit
  2. Sub Ex()
  3.     Dim Rng(1 To 2) As Range, Sh As Worksheet
  4.     For Each Sh In Sheets  ' Sheets 物件: 活頁簿Sheet的物件集合
  5.         Set Rng(1) = Sh.Cells.Find(Sh.Range("a4"), Sh.Range("a4")) ' [物品編號 ]所在列:為所有工作表表單上的共通點
  6.         If Not Rng(1) Is Nothing Then '工作表上有尋找到 [物品編號 ]
  7.             Set Rng(2) = Nothing
  8.             Do
  9.                 If Rng(2) Is Nothing Then
  10.                     Set Rng(2) = Rng(1).Offset(-3).Resize(4).EntireRow     '[物品編號 ]所在列 ,往上4列儲存格的整列
  11.                 Else
  12.                     Set Rng(2) = Union(Rng(2), Rng(1).Offset(-3).Resize(4).EntireRow)  ''整合:[物品編號 ]所在列 ,往上4列儲存格的整列
  13.                 End If
  14.                 Set Rng(1) = Sh.Cells.FindNext(Rng(1))
  15.             Loop Until Rng(1).Address(0, 0) = "A4"
  16.             If Not Rng(2) Is Nothing Then Rng(2).Delete   '刪除
  17.         End If
  18.     Next
  19. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 5# GBKEE
Rng(1) 、Rng(2) 以及 Union() 的處裡蠻細膩及扼要,
一針見血,簡明俐落。
謝謝您的賜教!

TOP

回復 5# GBKEE

謝謝Kubi大大和GBKEE超級板大的回答,非常的符合,但 又是不材小弟以為用個類似的表格就可利用程式來應用,真得實在太不材了,搞了好久,還是.........不行,
小弟把原始檔修改文字而已,再請老師們幫幫忙看一下,真得很感謝,又拍事。附檔: 刪除特定格式BB.rar (83.6 KB)

TOP

回復 7# man65boy
套用 GBKEE 大大的程式碼,並加上
  1.          If Sh.Range("a4") <> "" Then
  2.             .
  3.             .
  4.          End If
複製代碼
來過濾空白內容的表單:
  1. Sub Ex()
  2.     Dim Rng(1 To 12) As Range, Sh As Worksheet
  3.     For Each Sh In Sheets  ' Sheets 物件: 活頁簿Sheet的物件集合
  4.         If Sh.Range("a4") <> "" Then
  5.             Set Rng(1) = Sh.Cells.Find(Sh.Range("a4"), Sh.Range("a4")) ' [物品編號 ]所在列:為所有工作表表單上的共通點
  6.             If Not Rng(1) Is Nothing Then '工作表上有尋找到 [物品編號 ]
  7.                 Set Rng(2) = Nothing
  8.                 Do
  9.                     If Rng(2) Is Nothing Then
  10.                         Set Rng(2) = Rng(1).Offset(-3).Resize(4).EntireRow     '[物品編號 ]所在列 ,往上4列儲存格的整列
  11.                     Else
  12.                         Set Rng(2) = Union(Rng(2), Rng(1).Offset(-3).Resize(4).EntireRow)  ''整合:[物品編號 ]所在列 ,往上4列儲存格的整列
  13.                     End If
  14.                     Set Rng(1) = Sh.Cells.FindNext(Rng(1))
  15.                 Loop Until Rng(1).Address(0, 0) = "A4"
  16.                 If Not Rng(2) Is Nothing Then Rng(2).Delete   '刪除
  17.             End If
  18.         End If
  19.     Next
  20. End Sub
複製代碼

TOP

本帖最後由 man65boy 於 2016-6-4 15:25 編輯

回復 8# c_c_lai

謝謝老師的幫忙,如果我把A4的儲存格文字(物品編號)改為(日期),為何無法執行,再程式碼:Set Rng(1) = Sh.Cells.Find(Sh.Range("a4"), Sh.Range("a4")) ' [物品編號 ]所在列:為所有工作表表單上的共通點 ,不是都依A4的儲存格為主了嗎?怎麼我把所有"物品編號"改為"(日期)",會無法執行???(執行階段錯誤'1004')

TOP

回復 9# man65boy
另外一種解法,請參考
刪除特定格式BB-1.rar (20.44 KB)

TOP

        靜思自在 : 【時間如鑽石】時間對一個有智慧的人而言,就如鑽石般珍貴;但對愚人來說,卻像是一把泥土,一點價值也沒有。
返回列表 上一主題