如果列" A"是空的我如何使excel为唯一的单元格分配唯一的no#,并且不像复制的图像那样复制#重复的单元格。
答案 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