返回列表 上一主題 發帖

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

samwang

帖子
976 
主題
7 
精華
0 
積分
1018 
點名
0  
作業系統
Win10 
軟體版本
Office 2016 
閱讀權限
50 
性別
男 
註冊時間
2013-4-19 
最後登錄
2023-9-21 
1# 跳轉到 »
發表於 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

TOP

samwang

帖子
976 
主題
7 
精華
0 
積分
1018 
點名
0  
作業系統
Win10 
軟體版本
Office 2016 
閱讀權限
50 
性別
男 
註冊時間
2013-4-19 
最後登錄
2023-9-21 
2#
發表於 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

TOP

samwang

帖子
976 
主題
7 
精華
0 
積分
1018 
點名
0  
作業系統
Win10 
軟體版本
Office 2016 
閱讀權限
50 
性別
男 
註冊時間
2013-4-19 
最後登錄
2023-9-21 
3#
發表於 2022-3-25 07:50 | 顯示全部帖子
回復  samwang

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


如附件說明，謝謝
1.JPG

TOP

        靜思自在 : 【是否發揮了良能？】人間壽命因為短暫，才更顯得珍貴。難得來一趟人間，應問是否為人間發揮了自己的良能，而不要一味求長壽。
返回列表 上一主題