如何根据B中的值在A列中指定no,如果有任何Duplicated值,则指定相同的no.?

时间:2017-11-16 21:14:01

标签: excel excel-vba vba

enter image description here

如果列" A"是空的我如何使excel为唯一的单元格分配唯一的no#,并且不像复制的图像那样复制#重复的单元格。

1 个答案:

答案 0 :(得分:0)

虽然我确信可能有一种更简单的方法来完成你的任务,但这个似乎工作正常(免责声明:轻度测试)。

基本上,serialNumber会尝试在Col A中找到最高价值。如果未找到,则为其分配值1

RetCel尝试将自己设置为匹配的上一个单元格。如果未找到匹配项,则会分配当前的serialNumber值。如果找到匹配,则它将使用匹配的值。

serialNumber仅在使用该值时自行增加。

Option Explicit

Sub AssignUnique()

    On Error GoTo ErrHandler
    Dim ws As Worksheet, RngA As Range, RngB As Range, cel As Range
    Set ws = ThisWorkbook.Worksheets("Sheet3")
    Set RngA = ws.UsedRange.Columns("A")
    Set RngB = ws.UsedRange.Columns("B")

    If RngA.Column = 2 Then
        'In the event RngA is empty, UsedRange will make it col B
        Set RngA = RngA.Offset(, -1)
        Set RngB = RngB.Offset(, -1)
        If RngA.Column <> 1 Then
            Err.Raise vbObjectError + 1000, , "Error setting RngA"
        End If
    End If

    Dim RetCel As Range, serialNumber As Long
    serialNumber = WorksheetFunction.Max(RngA)
    If serialNumber = 0 Then serialNumber = 1
    For Each cel In RngB.Cells
        Set RetCel = Nothing
        On Error Resume Next
        Set RetCel = ws.Cells.Find(cel.Value, After:=Cells(cel.Row - 1, 2), _
            SearchDirection:=xlPrevious)
        Debug.Print RetCel.Address
        On Error GoTo ErrHandler
        If cel.Value = vbNullString Then
            'Do Nothing
        ElseIf RetCel Is Nothing Then
            cel.Offset(, -1).Value = serialNumber
            serialNumber = serialNumber + 1
        Else
            cel.Offset(, -1).Value = RetCel.Offset(, -1).Value
            If cel.Offset(, -1).Value = vbNullString Then
                cel.Offset(, -1).Value = serialNumber
                serialNumber = serialNumber + 1
            End If
        End If
    Next cel
    Exit Sub
ErrHandler:
    MsgBox Err.Description, vbCritical, "Runtime # " & Err.Number

End Sub