如何实现这样的效果呢？

shermanshao2000

如何实现这样的效果呢？

chenhangrong

效果如附件，为了增强对比，颜色添加到了下一行，可改在同行

feilanga

shermanshao2000

chenhangrong 发表于 2024-8-28 10:33
效果如附件，为了增强对比，颜色添加到了下一行，可改在同行

老师，填充的单元格为什么不够随机？  行动一次后，重新运行一次，填充的绿色还是第一次的单元格，不太会变化。

扇扇扇

试试

kyxfyzg

1. Sub test()
   
2.     Set d = CreateObject("scripting.dictionary")
   
3.     Dim rng As Range, arr()
   
4.         For Each rng In Rows(27).Cells
   
5.             If rng.Interior.ColorIndex = 3 Then d(rng.Column) = ""
   
6.         Next rng
   
7.         Do
   
8.             n = n + 1
   
9.             brr = d.keys
   
10.             m = WorksheetFunction.RandBetween(0, UBound(brr))
    
11.             ReDim Preserve arr(1 To n)
    
12.             arr(n) = brr(m)
    
13.             d.Remove (brr(m))
    
14.             For i = m + 1 To UBound(brr)
    
15.                 If brr(i) - brr(m) > 30 Then
    
16.                     Exit For
    
17.                 Else
    
18.                     d.Remove (brr(i))
    
19.                 End If
    
20.             Next i
    
21.             For j = m - 1 To 0 Step -1
    
22.                 If brr(m) - brr(j) > 30 Then
    
23.                     Exit For
    
24.                 Else
    
25.                     d.Remove (brr(j))
    
26.                 End If
    
27.             Next j
    
28.         Loop Until n = 40
    
29.         For i = 1 To 40
    
30.             Cells(27, arr(i)).Interior.ColorIndex = 4
    
31.         Next i
    
32. End Sub

复制代码

kyxfyzg

仅供参考。。。。。。。。。

chenhangrong

每次都会变化，目前设定的是随机间隔在30-40之间，变化不大，而且你要求要在红色的单元格上变化，所以变化的范围会更小些，可修改程序，让其变化更加明显