希望得到帮助

dalaohu12

需要能一个删除内容及颜色的vba 具体描述在附件
                                                      谢谢

lhm0926

Sub 清除()
    Dim r%
    For r = Range("A" & Rows.Count).End(xlUp).Row To 1 Step -1
        If Range("A" & r) <> "" And Range("A" & r).HasFormula = False Then Exit For
    Next
   
    With Rows(r + 1 & ":" & Rows.Count)
        .ClearContents
        .Interior.Color = xlNone
    End With
End Sub

xiangbaoan

Option Explicit

Sub test()
  Dim Cel As Range
  Set Cel = Columns(1).Find("*", , -4163, , , 2, 1)
  Cel.Offset(1).Resize(30, 300).ClearContents
  Range(Range("A7"), Cel).Resize(, 300).Interior.Color = xlNone
  Set Cel = nothing
End Sub

dalaohu12

xiangbaoan 发表于 2021-1-17 10:53
Option Explicit

Sub test()

你好，运行时有个问题，我希望保留Z行及前六行的涂色，结果是只保留了前六行的涂色，误删除Z行的涂色，而且Z行下面三十行的涂色没有得到删除。
    谢谢

dalaohu12

xiangbaoan 发表于 2021-1-17 10:53
Option Explicit

Sub test()

~~~~~~~~~~~~~~

dalaohu12

lhm0926 发表于 2021-1-17 10:01
Sub 清除()
    Dim r%
    For r = Range("A" & Rows.Count).End(xlUp).Row To 1 Step -1

你好，这个VBA运行后有两种情况一种是运行错误1004，无法对合并单元格进行修改；另一种是除了保留前四行，其它全部数据都被删除了
       谢谢

xiangbaoan

dalaohu12 发表于 2021-1-17 11:44
~~~~~~~~~~~~~~

babobo

Application.ScreenUpdating = False
Set Rng = Sheet1.Range("A:A")
For Each c In Rng
    If InStr(c.Formula, "=") Then
        c.Interior.Color = vbRed
        Exit Sub
        
    End If
Next

dalaohu12

xiangbaoan 发表于 2021-1-17 11:50

你好，我把想法又处理了下，并上传了问题（更新），方便的时候请给看一下
                                                                                                  

谢谢

xiangbaoan

dalaohu12 发表于 2021-1-17 14:29
你好，我把想法又处理了下，并上传了问题（更新），方便的时候请给看一下
                             ...

Sub test()
  Dim pos As Range, Cel As Range, Ran As Range
  Set pos = Columns(1).Find("*", , -4163, , , 2, 1)
  For Each Cel In pos.Offset(-30).Resize(30, 300)
    If Cel.Interior.Color = 255 Then
      If Not Ran Is Nothing Then Set Ran = Union(Ran, Cel) Else Set Ran = Cel
    End If
  Next
  If Not Ran Is Nothing Then Ran.Interior.Color = xlNone
  With pos.Offset(1).Resize(30, 300)
    .Interior.Color = xlNone
    .ClearContents
  End With
End Sub