如何在 VBA 中的范围内均匀分布已知数字
How to distribute a known number evenly across a range in VBA
我遇到了一个问题,我一直在尝试使用 VBA 在 range.The 中平均分配一个已知数字 问题是我需要找到数字在范围尽可能彼此相等,你能帮我吗?或提供意见?
数据集如下
已知数字由红色的“TV Comodin”行给出,这是我的尝试:
Sub Prueba()
Columns("A:A").Select
Set Cell = Selection.Find(What:="TV Comodín", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
ActiveCell = Cell
Cell.Select
comodin = ActiveCell.Offset(0, 1).Value2
Range("A2").Select
Firstrow = ActiveCell.Row
Selection.End(xlDown).Select
Lastrow = ActiveCell.Row
j = comodin
While (j > 0)
For i = 2 To Lastrow
Range("B2").Select
Range("B" & i) = Range("B" & i).Value + 1
If j > 0 Then j = j - 1
If j = 0 Then Exit For
Next
Wend
End Sub
基本上,我的代码找到“TV Comodin”行以获得循环将在其列的每一行中加 1 乘 1 的次数,
抱歉,我对 VBA 有点陌生,顺便谢谢你。
这是一种方法。找到范围内的最小数字:加一。重复直到完成(例如)55 次。
Sub Prueba()
Dim f As Range, ws As Worksheet, comodin As Long, rng As Range, m, mn
Set ws = ActiveSheet
Set rng = ws.Range("A2", ws.Range("A2").End(xlDown)).Offset(0, 1)
Set f = ws.Columns("A").Find(What:="TV Comodín", LookIn:=xlFormulas, _
LookAt:=xlWhole, MatchCase:=False)
If Not f Is Nothing Then
rng.Value = ws.Evaluate("=" & rng.Address() & "*1") 'fill empty cells with zeros
comodin = f.Offset(0, 1).Value
Do While comodin > 0
mn = Application.Min(rng)
If mn >= 100 Then Exit Do ' exit when no values are <100
m = Application.Match(mn, rng, 0)
rng.Cells(m).Value = rng.Cells(m).Value + 1
comodin = comodin - 1
Loop
Else
MsgBox "not found!"
End If
End Sub
我遇到了一个问题,我一直在尝试使用 VBA 在 range.The 中平均分配一个已知数字 问题是我需要找到数字在范围尽可能彼此相等,你能帮我吗?或提供意见?
数据集如下
已知数字由红色的“TV Comodin”行给出,这是我的尝试:
Sub Prueba()
Columns("A:A").Select
Set Cell = Selection.Find(What:="TV Comodín", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
ActiveCell = Cell
Cell.Select
comodin = ActiveCell.Offset(0, 1).Value2
Range("A2").Select
Firstrow = ActiveCell.Row
Selection.End(xlDown).Select
Lastrow = ActiveCell.Row
j = comodin
While (j > 0)
For i = 2 To Lastrow
Range("B2").Select
Range("B" & i) = Range("B" & i).Value + 1
If j > 0 Then j = j - 1
If j = 0 Then Exit For
Next
Wend
End Sub
基本上,我的代码找到“TV Comodin”行以获得循环将在其列的每一行中加 1 乘 1 的次数,
抱歉,我对 VBA 有点陌生,顺便谢谢你。
这是一种方法。找到范围内的最小数字:加一。重复直到完成(例如)55 次。
Sub Prueba()
Dim f As Range, ws As Worksheet, comodin As Long, rng As Range, m, mn
Set ws = ActiveSheet
Set rng = ws.Range("A2", ws.Range("A2").End(xlDown)).Offset(0, 1)
Set f = ws.Columns("A").Find(What:="TV Comodín", LookIn:=xlFormulas, _
LookAt:=xlWhole, MatchCase:=False)
If Not f Is Nothing Then
rng.Value = ws.Evaluate("=" & rng.Address() & "*1") 'fill empty cells with zeros
comodin = f.Offset(0, 1).Value
Do While comodin > 0
mn = Application.Min(rng)
If mn >= 100 Then Exit Do ' exit when no values are <100
m = Application.Match(mn, rng, 0)
rng.Cells(m).Value = rng.Cells(m).Value + 1
comodin = comodin - 1
Loop
Else
MsgBox "not found!"
End If
End Sub