返回列表 上一主題 發帖

[發問] 刪除整列有資料無底色

[發問] 刪除整列有資料無底色

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

原始資料



想要的狀況


刪除有資料無底色的列.rar (7.53 KB)
Just do it.

回復 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

TOP

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

   
Just do it.

TOP

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

TOP

回復 4# samwang

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

TOP

回復  samwang

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


如附件說明,謝謝

1.JPG (125.52 KB)

1.JPG

TOP

回復 6# samwang

Dear samwang,
感謝您的熱心教導,感恩感恩!
Just do it.

TOP

        靜思自在 : 【生命在呼吸間】佛陀說:「生命在呼吸間。」人無法管住自己的生命,更無法擋住死期,讓自己永住人間。既然生命去來這麼無常,我們更應該好好地愛惜它、利用它、充實它,讓這無常、寶貴的生命,散發它真善美的光輝,映照出生命真正的價值。
返回列表 上一主題