这样的填充效果，请帮忙实现一下，我对VBA真的不懂。

108937101

副本11.zip (45.13 KB, 下载次数: 3)

2023-4-16 09:59 上传

点击文件名下载附件

我想要上面这个效果。

在“数据填写区”填入数字，“行指引区”，对应这个数字，找出它这一行，有数字的列，并填充颜色，这一行没有数字的，不填充。

我对VBA一点不懂，但是想要这个效果，之前开个一个贴子，由于 本人的失误，把要求说错了，后来沉贴了，现在重新再开一个贴子，希望各位大神帮我实现 这个效果，谢谢。

psxk3535

理解能力强的来，帮顶一下

108937101

psxk3535 发表于 2023-4-16 09:24
理解能力强的来，帮顶一下

谢谢[code][/code]

鄂龙蒙

附件发上来呀，帮您做还要先做出表格吗？！

108937101

鄂龙蒙 发表于 2023-4-16 09:49
附件发上来呀，帮您做还要先做出表格吗？！

副本11.zip (45.13 KB, 下载次数: 4)

2023-4-16 09:58 上传

点击文件名下载附件

准提部林

格式條件//
Xl0000101.rar (25.61 KB, 下载次数: 7)

2023-4-16 10:17 上传

点击文件名下载附件

108937101

准提部林 发表于 2023-4-16 10:18
格式條件//

谢谢，我还是想用VBA来实现

micch

108937101 发表于 2023-4-16 09:58

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2.     Set Rng = Target(1)
   
3.     r = Rng.Row
   
4.     c = Rng.Column
   
5.     If r > 19 And c < 19 Then
   
6.         x = Rng.Value
   
7.         If Len(x) = 0 Then Exit Sub
   
8.         r1 = Cells(19, c).End(3).Row
   
9.         If r1 = 1 Then Exit Sub
   
10.         c1 = Cells(r1, 256).End(1).Column
    
11.         If c1 = c Then Exit Sub
    
12.         Application.EnableEvents = False
    
13.         For j = 20 To c1
    
14.             If Cells(r1, j).Value > 0 Then
    
15.                 Cells(r, j).Interior.Color = vbRed
    
16.             End If
    
17.         Next
    
18.         Application.EnableEvents = True
    
19.     End If
    
20. End Sub
    

复制代码

108937101

micch 发表于 2023-4-16 11:57

放哪里？怎么玩？

108937101

micch 发表于 2023-4-16 11:57