Macro o fórmula para generar códigos únicos
Estoy creando un inventario en Excel con macros, pero deseo que al ingresar los productos me genere un código único y que no se pueda repetir, de 4 dígitos numérico en una celda especifica.
1 respuesta
Esta macro lee una columna en este ejemplo producto si encuentra en la columna b alguna columna vacía genera un numero de código aleatorio de 4 cifras que compara con los ya existentes si ya existe lo descarta y genera otro numero, también coloca el ultimo numero que genero en una celda previamente elegida en ese caso d1
y esta es la macro
Sub generar_codigos()
Dim unicos As New Collection
Set datos = Range("a1").CurrentRegion
With datos
filas = .Rows.Count
For i = 1 To filas
codigo = .Cells(i, 2)
If IsEmpty(codigo) = True Then
otro:
codigo = WorksheetFunction.RandBetween(1000, 9999)
On Error Resume Next
unicos.Add codigo, CStr(codigo)
If Err.Number > 0 Then GoTo otro
.Cells(i, 2) = codigo
On Error GoTo 0
End If
Next i
Range("d1") = codigo
End With
set datos=nothing
End Sub
Saludos
Veo que funciona en una hoja nueva y como lo dices tu dices, pero yo tengo mi hoha llamada "BASE DATOS", mi lista de productos están en la columna A2 en adelante, y los códigos están en la columna H2 en delante.
También la macro se inserta desde otra hoja llamada "DETALLE DIARIO". Por eso meda un error
Gracias
Prueba esta macro sin importar desde que hoja la corras la macro siempre pondrá los códigos en la hoja base de datos a partir de la celda j2
esta es la macro
Sub generar_codigos()
Dim unicos As New Collection
Set h1 = Worksheets("base de datos")
Set datos = h1.Range("a1").CurrentRegion
col = Range("j1").Column
With datos
filas = .Rows.Count
For i = 2 To filas
codigo = .Cells(i, 2)
If IsEmpty(codigo) = True Then
otro:
codigo = WorksheetFunction.RandBetween(1000, 9999)
On Error Resume Next
unicos.Add codigo, CStr(codigo)
If Err.Number > 0 Then GoTo otro
.Cells(i, col) = codigo
On Error GoTo 0
End If
Next i
End With
Set datos = Nothing
End Sub
