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

標題: [發問] 刪除整列有資料無底色 [打印本頁]

作者: jsc0518 時間: 2022-3-22 20:14 標題: 刪除整列有資料無底色

Dear all,
此資料以A欄列為主，當A欄列下底色有顏色時，該列保留。
其餘有資料但無底色，"整列刪除"。
還請大家幫忙
示意圖如下

原始資料
[attach]34732[/attach]

想要的狀況
[attach]34733[/attach]

[attach]34734[/attach]

作者: samwang 時間: 2022-3-23 08:13

回復 1# jsc0518

請測試看看，謝謝
Sub test()
Dim xR As Range, R%, Clr
Application.ScreenUpdating = False
R = 1
With Sheets(1)
If .AutoFilterMode Then .[a1].AutoFilter
For Each xR In .Range(.[a1], .Cells(.Rows.Count, 1).End(3))
      Clr = xR.DisplayFormat.Interior.ColorIndex
      If Clr <> -4142 Then
         xR.Resize(, 1).Copy Sheets(2).Cells(R, 1)
         R = R + 1
      End If
Next
End With
Application.ScreenUpdating = True
End Sub

作者: jsc0518 時間: 2022-3-23 20:38

回復 2# samwang
Dear samwang,
您好，我想要在"原始資料"工作表下直接刪除無底色(有資料)的列(整列)
同一工作上執行，執行結果不需在複製到另一工作表上。
感謝您！:)

[attach]34737[/attach] [attach]34738[/attach]

作者: samwang 時間: 2022-3-24 07:43

本帖最後由 samwang 於 2022-3-24 07:51 編輯

回復 samwang
Dear samwang,
您好，我想要在"原始資料"工作表下直接刪除無底色(有資料)的列(整列)
同一 ...
jsc0518 發表於 2022-3-23 20:38

請再測試看看，謝謝
Sub test2()
Dim xR As Range, xU As Range, Clr
Application.ScreenUpdating = False
With Sheets(1)
If .AutoFilterMode Then .[a1].AutoFilter
For Each xR In .Range(.[a1], .Cells(.Rows.Count, 1).End(3))
      Clr = xR.DisplayFormat.Interior.ColorIndex
      If Not Clr <> -4142 Then
         If xU Is Nothing Then Set xU = xR Else Set xU = Union(xR, xU)
      End If
Next
End With
If Not xU Is Nothing Then xU.EntireRow.Delete
Application.ScreenUpdating = True
End Sub

作者: jsc0518 時間: 2022-3-24 22:08

回復 4# samwang

Dear samwang,
謝謝你可以用歐。
另外請教一下，若我的工作表為"工作表2"
是不是 Sheets(1) ---> 改成 Sheets(2)

作者: samwang 時間: 2022-3-25 07:50

回復 samwang

Dear samwang,
謝謝你可以用歐。
另外請教一下，若我的工作表為"工作表2"
是不是 She ...
jsc0518 發表於 2022-3-24 22:08

如附件說明，謝謝

作者: jsc0518 時間: 2022-3-25 20:40

回復 6# samwang

Dear samwang,
感謝您的熱心教導，感恩感恩！

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