Anónimo
Una macro con msgbox.
Necesito una macro que me avise cuando en una columna hay uno, o varios números distintos a todos los demás que deben ser iguales. La necesito con un msgbox que diría así: "semana distinta en celdas A1 Y A20". Por ejemplo.
1 Respuesta
Respuesta de vinmoni
1
No te puedo ayudar ya que no entiendo tu pregunta, si meenvias un ejemplo te lo intentarer aclarar
mi correo [email protected]
mi correo [email protected]
Mira uso esta macro para ver cantidades duplicadas en una columna.
Si las hay sale un mensaje .
Ahora necesito una macro que me avise cuando en una columna hay una cantidad diferente a las demás. Gracias por contestar.
Sub duplica()
'Establece el Rango de Datos
n = 1
While ActiveSheet.Range("A" & n).Value <> ""
n = n + 1
Wend
'Inicia las comparaciones
For i = 1 To n - 1
For j = i + 1 To n
If ActiveSheet.Range("A" & i).Value = ActiveSheet.Range("A" & j).Value Then
'Despliega mensaje
MsgBox "Valor duplicado: " & ActiveSheet.Range("A" & i).Value & " en Celdas A" & i & " y A" & j, , "Valor Duplicado"
End If
Next j
Next i
End Sub
Si las hay sale un mensaje .
Ahora necesito una macro que me avise cuando en una columna hay una cantidad diferente a las demás. Gracias por contestar.
Sub duplica()
'Establece el Rango de Datos
n = 1
While ActiveSheet.Range("A" & n).Value <> ""
n = n + 1
Wend
'Inicia las comparaciones
For i = 1 To n - 1
For j = i + 1 To n
If ActiveSheet.Range("A" & i).Value = ActiveSheet.Range("A" & j).Value Then
'Despliega mensaje
MsgBox "Valor duplicado: " & ActiveSheet.Range("A" & i).Value & " en Celdas A" & i & " y A" & j, , "Valor Duplicado"
End If
Next j
Next i
End Sub
Espero que te sirva:
Sub Distintos_Datos()
Dim Cell As Range
Dim Unicos As New Collection
Dim i As Integer, j As Integer
' Los datos se encuentran en la columna "A"
Set AllCells = Range("A:A")
On Error Resume Next
For Each Cell In Range("A:A")
'Si la celda esta vacia termina el bucle
If Cell.Value = "" Then Exit For
'El segundo argumento "key" para el método Add tiene que ser
'un texto y si este se repite se produce un error que se ignora
'con la instrucción on error y así no se añade a la colección.
Unicos.Add Cell.Address(False, False), CStr(Cell.Value)
Next Cell
For Each Item In Unicos
MsgBox "Datos distintos en celdas:" & Item
Next Item
End Sub
Sub Distintos_Datos()
Dim Cell As Range
Dim Unicos As New Collection
Dim i As Integer, j As Integer
' Los datos se encuentran en la columna "A"
Set AllCells = Range("A:A")
On Error Resume Next
For Each Cell In Range("A:A")
'Si la celda esta vacia termina el bucle
If Cell.Value = "" Then Exit For
'El segundo argumento "key" para el método Add tiene que ser
'un texto y si este se repite se produce un error que se ignora
'con la instrucción on error y así no se añade a la colección.
Unicos.Add Cell.Address(False, False), CStr(Cell.Value)
Next Cell
For Each Item In Unicos
MsgBox "Datos distintos en celdas:" & Item
Next Item
End Sub