Sumar cantidades de un código ya ingresado

buenas tardes amigos... Me podrían ayudar con lo siguientes

tengo un formulario que me llena un hoja de excel con códigos de un producto y cantidad

CÓDIGO CANT

123 2

456 1

A987 3

lo que necesito es un macro que al momento de ingresar un código nuevo me verifique si ya fue ingresado y me lo sume a cantidad

si dígito:

456 3

debería sumárselos al 456 de arriba y quedar con 4... Obviamente mostrándome un mensaje que me diga que el código ya existe y se van a sumar "X" a cantidad

Gracias por su valiosa ayuda.

1 Respuesta

Respuesta
1

Prueba con esta macro. Insértala en la misma hoja donde hagas la introducción de los datos

Private Sub Worksheet_Change(ByVal Target As Range)
Dim TargetCodigo, Rango, Rango2 As Range
Dim Lugar As String
If Not Intersect(Range("B:B"), Target) Is Nothing Then
   Set TargetCodigo = Target.Offset(0, -1)
   Lugar = TargetCodigo.Address
   Set Rango = Columns("A:A").Find(TargetCodigo)
   If Rango.Address = Lugar Then
      Set Rango2 = Rango
      Set Rango = Columns("A:A").FindNext(Rango)
      If Not Rango Is Nothing Then
         If Rango.Address <> Rango2.Address Then
            MsgBox ("El codigo " & TargetCodigo & " ya existe y se va a sumar la cantidad a él")
            Application.EnableEvents = False
            Cells(Rango.Row, Rango.Column + 1) = Cells(Rango.Row, Rango.Column + 1) + Target.Value
            Target.Delete
            TargetCodigo.Delete
            Application.EnableEvents = True
         End If
      End If
   Else
      Set Rango = Columns("A:A").FindNext(Rango)
      If Not Rango Is Nothing Then
         Set Rango2 = Rango
         MsgBox ("El codigo " & TargetCodigo & " ya existe y se va a sumar la cantidad a él")
         Application.EnableEvents = False
         Cells(Rango2.Row, Rango2.Column + 1) = Cells(Rango.Row, Rango.Column + 1) + Target.Value
         Target.Delete
         TargetCodigo.Delete
         Application.EnableEvents = False
      End If
   End If
   Set Rango = Nothing
   Set Rango2 = Nothing
   Set TargetCodigo = Nothing
End If
End Sub

La comprobación se efectúará cada vez que introduzcamos un dato en la columna B, asegurarse por tanto de introducir siempre antes el código y después la cantidad.

Espero que te sirva y lo hayas entendido. Si no es asi preguntaúntame las dudas. Y si ya está bien no olvides puntuar.

Hola gracias por tu ayuda... pero no me funciono ..lo inserte en una hoja y lo hizo una vez y luego no...

La verdad es esta...es que tengo un archivo para un conteo físico que captura unos datos (código y cantidad) y otros que los trae de una tabla con buscarV, la idea era que si yo digitaba 2 veces el mismo código me saliera un mensaje que dijera el CÓDIGO XXX ya fue ingresado desea sumar la cantidad?? si la respuesta es si pues sume y ya... para que me entiendas mejor te envío el archivo a ver si me puedes ayudar.. Gracias

http://www.mediafire.com/?ap824k5dg9cidmb

Si es verdad que funcionaba mal. Es que después de probar añadí unas líneas que suelen molestar en al fase de pruebas y una de ellas la escribí mal. Puse una

Application.EnableEvents = False

donde tenía que haber puesto

Application.EnableEvents = True

Y el efecto era que el programa ya no tenía en cuenta los eventos de cambio de datos.

Incluso verás que he añadido una macro EnablearEvents que a mí me ha venido bien para la fase de pruebas pero que no te hará falta.

Aparte de corregir eso he modificado la macro para adaptarla a la columna C en lugar de la B y he corregido otra cosa que hacía mal y he añadido la opción de que te pregunta si quieres añadirlos o no. Y he intentado corregir todos esos errores que se pueden dar cuando introduces varios datos de golpe mediante pegado o borras varios a la vez, haciendo que los procese todos sin problemas.

El mecanismo consiste en que examina si hay repetidos cuando se introduce la cantidad en la columna C, luego mete siempre primero el código y luego la cantidad.

Pondré aquí la macro por si puede servirle a alguien, pero a ti te voy a mandar dentro de un rato el fichero con ella incorporada. A mi ese fichero me daba algún problema de Orígenes de Datos ODBC pero a ti no te los dará.

La macro está insertada en la hoja BaseDatos

Private Sub Worksheet_Change(ByVal Target As Range)
Dim CeldaCodigo, Rango, Rango2, Celda As Range
Dim Lugar As String
Dim EstaRepe As Boolean
Dim Respuesta As Integer
If Not Intersect(Range("C:C"), Target) Is Nothing Then
  For Each Celda In Target
    Set CeldaCodigo = Celda.Offset(0, -2)
    If Celda <> "" And CeldaCodigo <> "" Then
      Lugar = CeldaCodigo.Address
      Set Rango = Columns("A:A").Find(CeldaCodigo)
      EstaRepe = False
      If Rango.Address = Lugar Then
        Set Rango2 = Rango
        Set Rango = Columns("A:A").FindNext(Rango)
        If Not Rango Is Nothing Then
          If Rango.Address <> Rango2.Address Then EstaRepe = True
        End If
      Else
        EstaRepe = True
      End If
      If EstaRepe Then
        Respuesta = MsgBox("El codigo " & CeldaCodigo & " ya existe en la fila " & Str(Rango.Row) & vbCrLf & _
                    VbCrLf & "¿Quiere sumar los datos en esa fila?", vbInformation + vbYesNo, "Datos Repetidos")
        If Respuesta = vbYes Then
          Application.EnableEvents = False
          Cells(Rango.Row, Rango.Column + 2) = Cells(Rango.Row, Rango.Column + 2) + Celda.Value
          Celda.Value = ""
          CeldaCodigo.Value = ""
          Application.EnableEvents = True
        End If
      End If
    End If
  Next Celda
  Set Rango = Nothing
  Set Rango2 = Nothing
  Set CeldaCodigo = Nothing
End If
End Sub

Y eso es todo, espera que te mando el fichero y ojala te sirva. Si no entiendes algo me lo preguntas. Y si ys está bien no olvides puntuar.

Por cierto!

Me mandaste el fichero por una página de descargas en lugar de por correo. Entonces no sé la forma de mandártelo. Mándame tu correo para que pueda mandártelo.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas