如何通过宏将含小数的数值列表按规则批量重编号为整数列表

你需要的编号规则为同值同编号、按原数值升序连续分配整数，和密集排名逻辑完全一致，使用Excel VBA宏即可完成数千条数据的批量处理，以下是可直接复用的方案：

可直接运行的VBA宏代码 #

Sub 生成连续整数编号()
    Dim sourceRng As Range, arr As Variant, dict As Object
    Dim i As Long, j As Long, rankNum As Long
    Dim sortedArr As Variant, temp As Variant
    
    ' 选择待处理的单列数据区域
    On Error Resume Next
    Set sourceRng = Application.InputBox("选择待处理的单列数值区域", "选择数据", Type:=8)
    On Error GoTo 0
    If sourceRng Is Nothing Then Exit Sub
    If sourceRng.Columns.Count > 1 Then
        MsgBox "请选择单列数据重新运行"
        Exit Sub
    End If
    
    arr = sourceRng.Value
    Set dict = CreateObject("Scripting.Dictionary")
    
    ' 提取所有不重复值
    For i = 1 To UBound(arr, 1)
        If Not dict.exists(arr(i, 1)) Then dict.Add arr(i, 1), ""
    Next
    sortedArr = dict.keys
    
    ' 对不重复值做升序排序
    For i = LBound(sortedArr) To UBound(sortedArr) - 1
        For j = i + 1 To UBound(sortedArr)
            If sortedArr(i) > sortedArr(j) Then
                temp = sortedArr(i)
                sortedArr(i) = sortedArr(j)
                sortedArr(j) = temp
            End If
        Next
    Next
    
    ' 为排序后的不重复值分配连续整数编号
    dict.RemoveAll
    rankNum = 1
    For i = LBound(sortedArr) To UBound(sortedArr)
        dict.Add sortedArr(i), rankNum
        rankNum = rankNum + 1
    Next
    
    ' 结果输出到所选区域右侧列，核对无误后可自行调整位置
    For i = 1 To UBound(arr, 1)
        sourceRng.Offset(0, 1).Cells(i, 1) = dict(arr(i, 1))
    Next
    
    MsgBox "处理完成，编号已生成在所选区域右侧"
End Sub

操作步骤 #

• 打开待处理数据所在的Excel文件，按Alt+F11快捷键打开VBA编辑器
• 在左侧工程面板右键点击当前工作簿名称，依次选择「插入」-「模块」，将上述代码完整粘贴到弹出的代码编辑窗口
• 按F5运行宏，按照弹窗提示选中存放待处理数值的单列区域，确认后即可自动生成编号
• 可先用测试数据[1,1,2,2.1,2.2,3,3,3.1,3.1,4]验证，输出结果为[1,1,2,3,4,5,5,6,6,7]，完全符合预期。

补充说明 #

• 运行宏前建议备份原始数据，避免误操作导致数据丢失
• 该方案可轻松承载万级以内的数据量，数千条数据处理无卡顿
• 若需要直接覆盖原数据列，将代码中sourceRng.Offset(0, 1).Cells(i, 1)修改为sourceRng.Cells(i, 1)即可

内容的提问来源于stack exchange，提问作者Jungshin Kim