[已解决]用VBA填充黄色背景区域内的统计次数

superle! · 发表于 2014-5-23 18:26

本帖最后由 superle! 于 2014-5-24 20:28 编辑

用VBA填充黄色背景区域内的统计次数。以第7行最后一个有值的右边的JY为准，如果JY有值的话，那么就以JZ为准，因为右边的数值会随时增加，统计数据等于7或大于7值的次数。
比如A7单元格内是填充2次。JX7的值是7，JW7的值8，而JV7的值没有等于7或大于7，所以没有隔的情况下，它只有2次。
B7填充统计1次，国为JW7是等于7或大于7，而JU7没有等于7或大于7，所以只统计出1次。下面的类推。

最佳答案

月排行榜 / 总排行榜

cbg2008

2014-5-24 20:16

superle! 发表于 2014-5-24 19:34
不好意思，麻烦你了，还有一个问题，就是从第7行开始。，，因为从第2行到第6行都有是值的，但不是数值，我 ...

Private Sub CommandButton1_Click()
Dim arrSrouce
Dim arrTarget()
Dim i%, j%, k%
With Sheets("sheet1")
arrSrouce = .Range(.Range("aa7"), .Range("aa7").End(xlDown).End(xlToRight))
ReDim arrTarget(1 To UBound(arrSrouce), 1 To 13)
For i = 1 To UBound(arrTarget)
For j = 1 To UBound(arrTarget, 2)
k = UBound(arrSrouce, 2) + 1
arrTarget(i, j) = 0
Do
k = k - j
If arrSrouce(i, k) >= 7 Then
arrTarget(i, j) = arrTarget(i, j) + 1
Else
Exit Do
End If
Loop
Next j
Next i
.Range("A7").Resize(UBound(arrTarget), UBound(arrTarget, 2)) = arrTarget
End With
End Sub

复制代码

需求最好一次说清，改来改去，大家麻烦

跳转到最佳答案楼层

fjmxwrs · 发表于 2014-5-23 18:50

看得很晕，没能理解

superle! · 发表于 2014-5-23 19:00

fjmxwrs 发表于 2014-5-23 18:50
看得很晕，没能理解

这样会不会看明白一点？

fjmxwrs · 发表于 2014-5-24 11:38

superle! 发表于 2014-5-23 19:00
这样会不会看明白一点？

你是做什么用的呀？看不懂什么意思

cbg2008 · 发表于 2014-5-24 13:02

superle! 发表于 2014-5-23 19:00
这样会不会看明白一点？

工作簿11.rar (26.17 KB, 下载次数: 8)

superle! · 发表于 2014-5-24 14:29

本帖最后由 superle! 于 2014-5-24 14:46 编辑

cbg2008 发表于 2014-5-24 13:02

如果我要统计的从第7行到300行填充。301行以下的我不想填充出来。应该怎么修改下代码？

cbg2008 · 发表于 2014-5-24 17:11

superle! 发表于 2014-5-24 14:29
如果我要统计的从第7行到300行填充。301行以下的我不想填充出来。应该怎么修改下代码？

ReDim arrTarget(1 To 300-7+1, 1 To 13)

superle! · 发表于 2014-5-24 19:34

cbg2008 发表于 2014-5-24 17:11
ReDim arrTarget(1 To 300-7+1, 1 To 13)

不好意思，麻烦你了，还有一个问题，就是从第7行开始。，，因为从第2行到第6行都有是值的，但不是数值，我不想让它统计出来。

cbg2008 · 发表于 2014-5-24 20:16

这个最佳答案由 cbg2008 给出，感谢 cbg2008 的回答。

单击隐藏图章

superle! 发表于 2014-5-24 19:34
不好意思，麻烦你了，还有一个问题，就是从第7行开始。，，因为从第2行到第6行都有是值的，但不是数值，我 ...

Private Sub CommandButton1_Click()
Dim arrSrouce
Dim arrTarget()
Dim i%, j%, k%
With Sheets("sheet1")
arrSrouce = .Range(.Range("aa7"), .Range("aa7").End(xlDown).End(xlToRight))
ReDim arrTarget(1 To UBound(arrSrouce), 1 To 13)
For i = 1 To UBound(arrTarget)
For j = 1 To UBound(arrTarget, 2)
k = UBound(arrSrouce, 2) + 1
arrTarget(i, j) = 0
Do
k = k - j
If arrSrouce(i, k) >= 7 Then
arrTarget(i, j) = arrTarget(i, j) + 1
Else
Exit Do
End If
Loop
Next j
Next i
.Range("A7").Resize(UBound(arrTarget), UBound(arrTarget, 2)) = arrTarget
End With
End Sub

复制代码

需求最好一次说清，改来改去，大家麻烦

		自动登录	找回密码
密码			注册