单元格从右到左每间隔4位数自动变红色，谢谢！！！

zyhui1961

单元格从右到左每间隔4位数自动变红色，谢谢！！！

ykcbf1100

附件请参考。。。

无敌小猪猪

ykcbf1100 发表于 2023-4-17 13:29
附件请参考。。。

Sub 标颜色()
    Dim i&, rng As Range
    Dim zs&, ys&, k&, l&
    For Each rng In Range("B9:B12,B16:B18,C7:C9,C17:C19")
        rng.Font.ColorIndex = xlAutomatic
        If Len(rng) > 4 Then
            l = Len(rng)   '字节长度
            zs = Int(l / 4)     '长度/4的整数
            ys = l Mod 4  '长度/4的余数
            If ys > 0 Then
                rng.Characters(Start:=1, Length:=ys).Font.ColorIndex = 3
            End If
            For i = zs To 1 Step -1
                k = k + 1
                If k = 2 Then
                    rng.Characters(Start:=l - i * 4 + 1, Length:=4).Font.ColorIndex = 3
                    k = 0
                End If
            Next
        End If
    Next
End Sub

无敌小猪猪

ykcbf1100 发表于 2023-4-17 13:29
附件请参考。。。

我感觉应该还是要考虑下余数

ykcbf1100

无敌小猪猪 发表于 2023-4-17 14:10
我感觉应该还是要考虑下余数

你说的不无道理，但目前感觉这样就行。

zyhui1961

ykcbf1100 发表于 2023-4-17 13:29
附件请参考。。。

我改一下就出现下面提示，是什么意思？还要怎么改动？谢谢！

bxm78

参与一下：

zyhui1961

无敌小猪猪 发表于 2023-4-17 14:10
Sub 标颜色()
    Dim i&, rng As Range
    Dim zs&, ys&, k&, l&

我的工作表哪设置的不对呢？运行代码就出现错误提示：

ykcbf1100

zyhui1961 发表于 2023-4-17 14:53
我改一下就出现下面提示，是什么意思？还要怎么改动？谢谢！

你在运行代码前，先把需要改颜色的表激活。

zyhui1961

ykcbf1100 发表于 2023-4-17 15:50
你在运行代码前，先把需要改颜色的表激活。

激活了，就是在这个工作表运行代码。我感觉是我的工作簿问题，但是又不知道是什么问题，用我上传的单独的附件就能运行，复制或移动到我的另外一个工作簿就不能运行！