任意位置区域与A列开始的区域进行条件格式设置

njwtg

老师好，有个想法，不知道能否实现，在当前工作表中，当我选中某个区域时，假如有12列，就自动将该12列与ABCD...L列进行比对，值不同时选中区域的单元格就用红色填充，字体为白色。如果选中的是5列，就自动与ABCDE进行比对，值不同时选中区域单元格就用红色填充，字体为白色。比对的区域为：选中区域往下延伸至行号为5000的行，谢谢！

njwtg

用文心生成的代码，粘贴到编辑器中，  With conditionRange.Columns(i).FormatConditions.Add(Type:=xlExpression, Formula1:="=" & Cells(1, columnOffset).Address & "<>"" & Char(65 + i - 1) & """")这段是红色的字体，无法测试

Sub SetConditionalFormatting()
    Dim selectedRange As Range
    Dim firstColumn As Integer
    Dim selectedColumns As Integer
    Dim columnOffset As Integer
    Dim conditionRange As Range
    Dim condition As FormatCondition
    Dim i As Integer
      
    ' 显示“请选择区域”对话框，并获取用户选择的区域
    On Error Resume Next ' 如果用户取消选择，则忽略错误
    Set selectedRange = Application.InputBox("请选择区域", Type:=8) ' Type 8 表示区域类型
    On Error GoTo 0 ' 恢复正常错误处理
      
    ' 如果用户没有选择任何区域或取消了选择，则退出程序
    If selectedRange Is Nothing Then
        MsgBox "未选择任何区域，程序退出。"
        Exit Sub
    End If
      
    ' 获取选中区域最左边的列号
    firstColumn = selectedRange.Columns(1).Column
    ' 获取选中区域的列数
    selectedColumns = selectedRange.Columns.Count
      
    ' 判断选中区域最左边的列与A列之间列的数量是否小于选中区域的列数
    If firstColumn - 1 < selectedColumns Then
        MsgBox "列的数量多了"
        Exit Sub
    End If
      
    ' 设置条件格式的区域，从选中区域的顶端的行号到5000行
    Set conditionRange = Range(selectedRange.Cells(1, 1).Address & ":" & Cells(5000, selectedRange.Columns.Count).Address)
      
    ' 清除原有条件格式，如果不需要请注释掉以下两行
    'conditionRange.ClearFormats
    'conditionRange.FormatConditions.Delete
      
    ' 为每一列添加条件格式
    For i = 1 To selectedColumns
        columnOffset = firstColumn + i - 1 ' 转换为实际的列号
         
        ' 添加条件格式
     With conditionRange.Columns(i).FormatConditions.Add(Type:=xlExpression, Formula1:="=" & Cells(1, columnOffset).Address & "<>"" & Char(65 + i - 1) & """")
            .SetFirstPriority ' 确保条件格式排列在第一位
            With .Font
                .Color = RGB(255, 255, 255) ' 白色
            End With
            .Interior.Color = RGB(255, 0, 0) ' 红色
        End With
    Next i
      
    MsgBox "条件格式设置完成。"
End Sub

taller

njwtg

谢谢taller老师，我测试了下，有点小问题，

njwtg

我想要的效果是每一行都进行比对，现在好像只根据选中区域的第一行比对

njwtg

假如我选中的是第7行的LMN列，程序生成的条件格式公式是=K$7<>IV65530，其实应该是=L7<>A7

lln0618

row1 = Range(Selection.Address).Row '选中区域开始行
   row2 = Range(Selection.Address).Rows.Count + row1 - 1 '选中区域最后一行
   
   col1 = Range(Selection.Address).Column '选中区域开始列
   col2 = Range(Selection.Address).Columns.Count + col1 - 1 '选中区域最后一列

njwtg

不明白怎么调整代码，谢谢lln0618老师

taller

你录入的代码有错误，请仔细核对

1. sForm = "=" & selRng.Cells(1).Address(0, 0) & "<>A" & selRng.Row
   
2. .TintAndShade = 0

复制代码

njwtg

一、如果选中i7：k7，运行后条件格式不对
二、如果再次运行后条件格式业与之前的不一样
三、感觉每次运行后条件格式的公式一次与一次不同
谢谢taller老师
Sub SetFC()
Dim selRng As Range, oFC As FormatCondition
Dim sForm As String
Const LASTROW = 1000
Set selRng = Application.InputBox("请选择", Type:=8)
If Not selRng Is Nothing Then
If selRng.Column - 1 < selRng.Columns.Count Then
MsgBox "选中区域不合规"
Exit Sub
Else
sForm = "=" & selRng.Cells(1).Address(0, 0) & "<>A" & selRng.Row
Set oFC = selRng.Rows(1).Resize(LASTROW - i + 1).FormatConditions.Add( _
      Type:=xlExpression, Formula1:=sForm)
oFC.SetFirstPriority
With oFC.Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
With oFC.Interior
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
End With
End If
End If
End Sub