将数字分布在一个范围内，以便该范围内的数字尽可能彼此相等

Question

我正在尝试在一个范围内分配一个数字。

我需要范围内的数字尽可能彼此相等。

数据集如下：

已知的数字由红色的“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 的次数。

Answer 1

这是一种方法。找到范围内最小的数字：加一。重复直到您完成（例如）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