帖子: 169
主題: 39
精華: 0
積分: 252
點名: 0
作業系統: XP
軟體版本: 2003
閱讀權限: 20
註冊時間: 2011-4-17
最後登錄: 2020-7-17

2012龍年全勤獎章 2011兔年全勤獎章

1^# 跳轉到 » 倒序看帖

打印

字體大小: tT

發表於 2016-6-3 09:56 | 只看該作者

[發問] vba特定格式刪除

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

20160603.rar (21.62 KB)

樓主熱帖

Kubi

中學生 Rank: 2

帖子: 163
主題: 1
精華: 0
積分: 170
點名: 0
作業系統: Window 7
軟體版本: Office 2007
閱讀權限: 20
性別: 男
註冊時間: 2010-9-5
最後登錄: 2022-7-20

2^#

發表於 2016-6-3 13:31 | 只看該作者

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

man65boy

中學生 Rank: 2

帖子: 169
主題: 39
精華: 0
積分: 252
點名: 0
作業系統: XP
軟體版本: 2003
閱讀權限: 20
註冊時間: 2011-4-17
最後登錄: 2020-7-17

2012龍年全勤獎章 2011兔年全勤獎章

3^#

發表於 2016-6-3 19:42 | 只看該作者

回復 2# Kubi

感謝Kubi大大的回答，刪除的很整確，但再拜託一下，還有另一種格式，所以程式沒法用，另一個問題在SHEEET2 ，刪除的方式，根SHEET1一樣，附檔:

20160603AA.rar (29.82 KB)
謝謝!

TOP

Kubi

中學生 Rank: 2

帖子: 163
主題: 1
精華: 0
積分: 170
點名: 0
作業系統: Window 7
軟體版本: Office 2007
閱讀權限: 20
性別: 男
註冊時間: 2010-9-5
最後登錄: 2022-7-20

4^#

發表於 2016-6-3 20:46 | 只看該作者

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

GBKEE

超級版主 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^#

發表於 2016-6-4 06:11 | 只看該作者

回復 3# man65boy

試試看

Option Explicit
Sub Ex()
Dim Rng(1 To 2) As Range, Sh As Worksheet
For Each Sh In Sheets ' Sheets 物件: 活頁簿Sheet的物件集合
Set Rng(1) = Sh.Cells.Find(Sh.Range("a4"), Sh.Range("a4")) ' [物品編號 ]所在列:為所有工作表表單上的共通點
If Not Rng(1) Is Nothing Then '工作表上有尋找到 [物品編號 ]
Set Rng(2) = Nothing
Do
If Rng(2) Is Nothing Then
Set Rng(2) = Rng(1).Offset(-3).Resize(4).EntireRow '[物品編號 ]所在列 ,往上4列儲存格的整列
Else
Set Rng(2) = Union(Rng(2), Rng(1).Offset(-3).Resize(4).EntireRow) ''整合:[物品編號 ]所在列 ,往上4列儲存格的整列
End If
Set Rng(1) = Sh.Cells.FindNext(Rng(1))
Loop Until Rng(1).Address(0, 0) = "A4"
If Not Rng(2) Is Nothing Then Rng(2).Delete '刪除
End If
Next
End Sub

複製代碼

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

TOP

c_c_lai

博士班 Rank: 6 Rank: 6

帖子: 2035
主題: 24
精華: 0
積分: 2031
點名: 0
作業系統: Win7
軟體版本: Office2010
閱讀權限: 100
性別: 男
註冊時間: 2012-3-22
最後登錄: 2024-2-1

6^#

發表於 2016-6-4 08:58 | 只看該作者

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

TOP

man65boy

中學生 Rank: 2

帖子: 169
主題: 39
精華: 0
積分: 252
點名: 0
作業系統: XP
軟體版本: 2003
閱讀權限: 20
註冊時間: 2011-4-17
最後登錄: 2020-7-17

2012龍年全勤獎章 2011兔年全勤獎章

7^#

發表於 2016-6-4 10:42 | 只看該作者

回復 5# GBKEE

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

刪除特定格式BB.rar (83.6 KB)

TOP

c_c_lai

博士班 Rank: 6 Rank: 6

帖子: 2035
主題: 24
精華: 0
積分: 2031
點名: 0
作業系統: Win7
軟體版本: Office2010
閱讀權限: 100
性別: 男
註冊時間: 2012-3-22
最後登錄: 2024-2-1

8^#

發表於 2016-6-4 11:24 | 只看該作者

回復 7# man65boy
套用 GBKEE 大大的程式碼，並加上

If Sh.Range("a4") <> "" Then
.
.
End If

複製代碼

來過濾空白內容的表單：

Sub Ex()
Dim Rng(1 To 12) As Range, Sh As Worksheet
For Each Sh In Sheets ' Sheets 物件: 活頁簿Sheet的物件集合
If Sh.Range("a4") <> "" Then
Set Rng(1) = Sh.Cells.Find(Sh.Range("a4"), Sh.Range("a4")) ' [物品編號 ]所在列:為所有工作表表單上的共通點
If Not Rng(1) Is Nothing Then '工作表上有尋找到 [物品編號 ]
Set Rng(2) = Nothing
Do
If Rng(2) Is Nothing Then
Set Rng(2) = Rng(1).Offset(-3).Resize(4).EntireRow '[物品編號 ]所在列 ,往上4列儲存格的整列
Else
Set Rng(2) = Union(Rng(2), Rng(1).Offset(-3).Resize(4).EntireRow) ''整合:[物品編號 ]所在列 ,往上4列儲存格的整列
End If
Set Rng(1) = Sh.Cells.FindNext(Rng(1))
Loop Until Rng(1).Address(0, 0) = "A4"
If Not Rng(2) Is Nothing Then Rng(2).Delete '刪除
End If
End If
Next
End Sub

複製代碼

TOP

man65boy

中學生 Rank: 2

帖子: 169
主題: 39
精華: 0
積分: 252
點名: 0
作業系統: XP
軟體版本: 2003
閱讀權限: 20
註冊時間: 2011-4-17
最後登錄: 2020-7-17

2012龍年全勤獎章 2011兔年全勤獎章

9^#

發表於 2016-6-4 15:22 | 只看該作者

本帖最後由 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

Kubi

中學生 Rank: 2

帖子: 163
主題: 1
精華: 0
積分: 170
點名: 0
作業系統: Window 7
軟體版本: Office 2007
閱讀權限: 20
性別: 男
註冊時間: 2010-9-5
最後登錄: 2022-7-20

10^#

發表於 2016-6-4 20:11 | 只看該作者

回復 9# man65boy
另外一種解法，請參考

刪除特定格式BB-1.rar (20.44 KB) 。

TOP