[已解决]删除指定颜色单元格内容

245747772

如附件，谢谢

最佳答案

月排行榜 / 总排行榜

as0810114

2014-12-16 23:45

Sub test()
    Dim i
    Dim arr
    Dim rarr(1 To 100, 1 To 1)
    arr = Sheets(2).Range("g1").CurrentRegion
    For i = 1 To UBound(arr)
        If arr(i, 1) = 3 And Sheets(2).Range("G" & i).Interior.ColorIndex = Sheets(2).Range("i4").Interior.ColorIndex Then
            k = k + 1
            rarr(k, 1) = Sheets(2).Range("A" & i)
        End If
    Next
    Range("a1").Resize(k, 1) = rarr
End Sub

跳转到最佳答案楼层

as0810114

1. Sub test()
   
2.     Dim i, irow
   
3.     irow = Cells(Rows.Count, "g").End(xlUp).Row
   
4.     For i = irow To 1 Step -1
   
5.         If Range("G" & i).Interior.ColorIndex = Range("c1").Interior.ColorIndex Then
   
6.             Range("G" & i).Delete
   
7.         End If
   
8.     Next
   
9. End Sub

复制代码

245747772

as0810114 发表于 2014-12-16 22:55

神速{:211:}

245747772

as0810114 发表于 2014-12-16 22:55

老师，我需要保留原有的单元格不动，谢谢

245747772

as0810114 发表于 2014-12-16 22:55

保留单元格的颜色和位置，只删除指定颜色的内容，刚刚测试，位置会变动，和颜色一起也删除了

high12345

查找－〉*，选项，背景色1－〉全选查找结果，删除内容

as0810114

Sub test()
    Dim i, irow
    irow = Cells(Rows.Count, "g").End(xlUp).Row
    For i = irow To 1 Step -1
        If Range("G" & i).Interior.ColorIndex = Range("c1").Interior.ColorIndex Then
            Range("G" & i).ClearContents
        End If
    Next
End Sub

245747772

as0810114 发表于 2014-12-16 23:08
Sub test()
    Dim i, irow
    irow = Cells(Rows.Count, "g").End(xlUp).Row

行了，谢谢老师

245747772

as0810114 发表于 2014-12-16 23:08
Sub test()
    Dim i, irow
    irow = Cells(Rows.Count, "g").End(xlUp).Row

老师 帮忙加个条件   问题在文件里面

as0810114

Sub test()
    Dim i
    Dim arr
    Dim rarr(1 To 100, 1 To 1)
    arr = Sheets(2).Range("g1").CurrentRegion
    For i = 1 To UBound(arr)
        If arr(i, 1) = 3 And Sheets(2).Range("G" & i).Interior.ColorIndex = Sheets(2).Range("i4").Interior.ColorIndex Then
            k = k + 1
            rarr(k, 1) = Sheets(2).Range("A" & i)
        End If
    Next
    Range("a1").Resize(k, 1) = rarr
End Sub