字符串右边的第3、4位数据可以进行寻找和比较吗？

gzminge

能不能以单元格里面的右边第3、4位数来查找下一列的单元格，找出同样右边第3、4位数相同的单元格，再判断该单元格的右边第1、2位数是否为00。

比如，B6里面的右边第3、4位数是46，而C4的右边第3、4位数也是46，并且C4的右边第1、2位数是00，所以填充金黄的颜色。这个操作能不能用程序来实现？然后对B2:L81区域里面的每个单元格都进行这样的操作。



浮萍.zip (208.8 KB, 下载次数: 5)

2024-10-27 17:59 上传

点击文件名下载附件

lcluck2002

在Worksheet_SelectionChange中使用如下代码试一下：

shiruiqiang

right（单元格，2）

quqiyuan

参与一下，仅供参考。。。

quqiyuan

代码如下，，，
Sub test()
    Application.ScreenUpdating = False
    With Sheets("sheet4")
        .UsedRange.Interior.Color = xlNone
        Arr = .Range(.[a1], .UsedRange)
        For j = 2 To UBound(Arr, 2) - 1
            For i = 2 To UBound(Arr)
                s = Arr(i, j)
                For k = 2 To UBound(Arr)
                    If Right(Arr(k, j + 1), 2) = "00" Then
                        If Mid(Right(Arr(k, j + 1), 4), 1, 2) = Mid(Right(s, 4), 1, 2) Then
                            .Cells(i, j).Interior.Color = RGB(255, 192, 0)
                        End If
                    End If
                Next
            Next
        Next
    End With
    Beep
    Application.ScreenUpdating = True
End Sub

gzminge

quqiyuan 发表于 2024-10-27 20:18
代码如下，，，
Sub test()
    Application.ScreenUpdating = False

如果还需要对sheet1，sheet2，sheet3工作进行操作，程序应该怎么修改？

gzminge

quqiyuan 发表于 2024-10-27 20:17
参与一下，仅供参考。。。

请教如果还需要同时对sheet1，sheet2，sheet3工作进行同样的操作，程序应该怎么修改？

quqiyuan

gzminge 发表于 2024-10-27 21:32
请教如果还需要同时对sheet1，sheet2，sheet3工作进行同样的操作，程序应该怎么修改？

单元格的内容都不一样，怎么搞，其实这个一个搞出来了，你修改不难了，你对着看，修改，调试一下

gzminge

quqiyuan 发表于 2024-10-27 21:38
单元格的内容都不一样，怎么搞，其实这个一个搞出来了，你修改不难了，你对着看，修改，调试一下

我把其他的工作表内容改为相同的形式了，但是我改了一下程序就出错，你看看是哪里出问题：
Sub test()
    Application.ScreenUpdating = False
    a = [{"Sheet1","Sheet2","Sheet3"}]
   For Each aa In a
   With Sheets(aa)
        .UsedRange.Interior.Color = xlNone
        Arr = .Range(.[a1], .UsedRange)
        For j = 2 To UBound(Arr, 2) - 1
            For i = 2 To UBound(Arr)
                s = Arr(i, j)
                For k = 2 To UBound(Arr)
                    If Right(Arr(k, j + 1), 2) = "00" Then
                        If Mid(Right(Arr(k, j + 1), 4), 1, 2) = Mid(Right(s, 4), 1, 2) Then
                            .Cells(i, j).Interior.Color = RGB(255, 192, 0)
                        End If
                    End If
                Next
            Next
        Next
    End With
    Beep
    Application.ScreenUpdating = True
End Sub

quqiyuan

gzminge 发表于 2024-10-27 22:33
我把其他的工作表内容改为相同的形式了，但是我改了一下程序就出错，你看看是哪里出问题：
Sub test()
...