VBA：按顺序对范围内的单元格进行编号，直至达到最大值

Question

所以我想对以下范围内的单元格进行编号：

R1 = Union(Range("A2:A24"), Range("E2:E24"), Range("I2:I17")).Select

我的目标是为它们分配数字，从 1 开始一直到设定的最大值。

Var = Application.WorksheetFunction.CountIf(Range("C6:C" & L1), "2")

如果 Var 小于范围内的单元格数量，我希望剩余的单元格为空。

Answer 1

您可以使用以下模板

    Sub NumberCellsInRange()
        Dim rng As Range
        Dim cell As Range
        Dim maxNumber As Long
        Dim currentNumber As Long
        Dim totalCells As Long
    
        ' Define the range you want to work with
        Set rng = Range("A1:b5") ' Change this to your desired range
        ' In your case, you don't need to select it
        ' R1 = Union(Range("A2:A24"), Range("E2:E24"), Range("I2:I17"))
        
        ' How many cells to number
        maxNumber = 5
        ' In your case, why var? It's a number
        ' Var = Application.WorksheetFunction.CountIf(Range("C6:C" & L1), "2")
        
        ' Initialize the counter
        currentNumber = 1
        totalCells = rng.Count
    
        ' Loop through each cell in the range
        For Each cell In rng
            If currentNumber <= maxNumber Then
                cell.Value = currentNumber
                currentNumber = currentNumber + 1
            Else
                cell.Value = "" ' Leave remaining cells empty
            End If
        Next cell
    End Sub

Answer 2

我想这个宏应该能满足你的目标：

Option Explicit

Sub asdfasd()
  Dim R1 As Range, Var As Long, L1 As Long, rc As Long
  Dim i As Long, j As Long, k As Long
  L1 = 1000 ' simulated value
  Set R1 = Union(Range("A2:A24"), Range("E2:E24"), Range("I2:I17"))
  Var = Application.WorksheetFunction.CountIf(Range("C6:C" & L1), "2")
  Var = 50 ' simulated value
  rc = R1.Cells.Count
  If Var < rc Then rc = Var
  j = 1
  For k = 1 To R1.Areas.Count
    With R1.Areas(k)
      For i = 1 To .Cells.Count
        .Cells(i) = IIf(j <= Var, j, "")
        j = j + 1
      Next
    End With
  Next
End Sub