这个代码怎么修改为只在符合条件的当中随机选取一个显示？

小年玩卡

想要实现的效果：比如下面图片中的C5，能否每次只是在符合条件的测试1，测试3中随机选择一个显示呢，其他行依此了推！

代码如下：
Sub test()
  Dim r%, i%
  Dim arr, brr
  With Worksheets("sheet1")
    r = .Cells(.Rows.Count, 1).End(xlUp).Row
    arr = .Range("g4:i" & r)
    r = .Cells(.Rows.Count, 1).End(xlUp).Row
    .Range("c5:e" & r) = ""
    brr = .Range("a5:e" & r)
    For i = 1 To UBound(brr)
      If Len(brr(i, 2)) <> 0 And brr(i, 2) <> 0 Then
        For j = 1 To UBound(arr)
          If brr(i, 2) >= arr(j, 2) And brr(i, 2) <= arr(j, 3) Then
            brr(i, 3) = brr(i, 3) & "," & arr(j, 1)
          End If
        Next
      End If
    Next
    For i = 1 To UBound(brr)
      If Len(brr(i, 3)) <> 0 Then
        brr(i, 3) = Mid(brr(i, 3), 2)
      End If
    Next
    .Range("a5:e" & r) = brr
  End With
End Sub

现在的图片效果如下：

附件：
模板.7z (30.93 KB, 下载次数: 2)

2019-3-8 20:09 上传

点击文件名下载附件

micch

1. Sub tt()
   
2.     arr = Range("c5", [b5].End(4))
   
3.     brr = [g4:i9]
   
4.     Randomize
   
5.     For i = 1 To UBound(arr)
   
6.         s = "": n = 0
   
7.         For k = 1 To UBound(brr)
   
8.             If arr(i, 1) >= brr(k, 2) And arr(i, 1) <= brr(k, 3) Then _
   
9.                 s = s & " " & brr(k, 1): n = n + 1
   
10.         Next
    
11.         arr(i, 2) = Split(s)(Int(Rnd() * n + 1))
    
12.     Next
    
13.     Range("c5", [b5].End(4)) = arr
    
14. End Sub
    

复制代码

小年玩卡

micch 发表于 2019-3-8 20:56

谢谢，这个代码怎么添加如果B列数据0时C列为空

micch

小年玩卡 发表于 2019-3-8 21:09
谢谢，这个代码怎么添加如果B列数据0时C列为空

[b5].End(4)  这里定位B列最后一行位置，前提是假设B列中间没有空单元格,所以不需要判断B列是空。
如果b列有空值，那存入数组就不能这么写。判断条件加到5句和6句之间
for i = 1 to ......

if len(arr(i,1)) >0 then
...

..
..
end if

next i

小年玩卡

micch 发表于 2019-3-8 21:18
.End(4)  这里定位B列最后一行位置，前提是假设B列中间没有空单元格,所以不需要判断B列是空。
如果b列有 ...

实际的数据是这样的，上面有数据的地方不会为0 只可能出现一个负数，B列最后一非空单元格后都是0，比如14,15，应该C列对应的为空

micch

1. Sub tt()
   
2.     arr = Range("c5", [b65536].End(3))
   
3.     [c5].Resize(UBound(arr), 3).ClearContents
   
4.     brr = [g4:i9]
   
5.     Randomize
   
6.     For i = 1 To UBound(arr)
   
7.         If arr(i, 1) <> 0 And Len(arr(i, 1)) Then
   
8.             s = "": n = 0
   
9.             For k = 1 To UBound(brr)
   
10.                 If arr(i, 1) >= brr(k, 2) And arr(i, 1) <= brr(k, 3) Then _
    
11.                     s = s & " " & brr(k, 1): n = n + 1
    
12.             Next
    
13.             arr(i, 2) = Split(s)(Int(Rnd() * n + 1))
    
14.         End If
    
15.     Next
    
16.     Range("c5", [b5].End(4)) = arr
    
17. End Sub

复制代码

小年玩卡

micch 发表于 2019-3-8 21:43

谢谢，改成0 还是不会消失 是怎么回事

micch

小年玩卡 发表于 2019-3-8 21:56
谢谢，改成0 还是不会消失 是怎么回事

第三行，清楚C列的结果，那里改了一下，因为是合并单元格，直接删除3列的内容，就清空了。然后再得到的结果应该0对应的就是空

小年玩卡

micch 发表于 2019-3-8 22:14
第三行，清楚C列的结果，那里改了一下，因为是合并单元格，直接删除3列的内容，就清空了。然后再得到的结 ...

现在的情况如果直接删除B列相应数据，C列对应会清空，如果B列为0就不清空了，应用中除了有数据外 后面的都是0
试了好多次，不知道怎么修改，能否帮忙修改  谢谢

micch

小年玩卡 发表于 2019-3-8 22:27
现在的情况如果直接删除B列相应数据，C列对应会清空，如果B列为0就不清空了，应用中除了有数据外 后面的 ...

没听明白什么意思，B列只要有数据，代码就会清空C列对应行的内容。有0也清空。