Movimiento ELIMINAR en Macro completar kardex según tabla de movimientos
Dante Amor, en el archivo que te envíe en la pregunta anterior en la columna "tipo de movimiento" hay varias filas que contienen la palabra "ELIMINAR", esta palabra la pongo para que después cuando se haga mantenimiento el el sistema de almacen estos movientos puedan ser eliminados, por ese motivo no procedo a borrarlo del excel.
La pregunta es la siguiente:
1.- En la tabla de movientos, agregare la palabra ELIMINAR como otra opción más.
2.- Que modificación tiene que haber en la macro para que cuando encuentre en la columna "tipo de movimiento" la palabra ELIMINAR la macro proceda a completar con "0" las casillas correspondientes.
1 respuesta
Hola Dante aquí te muestro la opción eliminar y te acabo de enviar el archivo, gracias, JOHNMOR41
Hola Dante te acabo de envier el archivo con la MACRO "CompletaKardex" como ver en la imagen, por favor necesito que la MACRO llene con ceros los casilleros en la fila donde encuentre la opción ( o palabra ) "ELIMINAR, saludos, JOHNMOR41. (nota el archivo solo contiene 5 registros, he eliminado lo demás para que no pese demasiado)
Te anexo la macro actualizada
Sub CompletaKardex()
'Por.Dante Amor
'FUNCIONA OPERACION INGRESO X COMPRA
Set h1 = Sheets("KARDEX")
Set h2 = Sheets("TABLA MOVIMIENTOS")
'TIPO DE MOVIMIENTO "R" en KX
For i = 3 To h1.Range("R" & Rows.Count).End(xlUp).Row
'T-12 CODIGO MOVIMIENTO "S" en KX
If h1.Cells(i, "S") = "" Then
For j = 7 To 20
'TIPO MOVIMIENTO "C" en tabla
'TIPO MOVIMIENTO "R" en KX
If h2.Cells(j, "C") = h1.Cells(i, "R") Then
If h2.Cells(j, "C") = "ELIMINIAR" Then
h1.Cells(i, "O") = "00"
h1.Cells(i, "P") = "00"
h1.Cells(i, "Q") = "00"
h1.Cells(i, "S") = "00"
Else
'REFERENCIA "H" en tabla
If h2.Cells(j, "H") = "vacio" Then
'T-12 "D" en tabla
t12 = h2.Cells(j, "D")
'T-10 "E" en tabla
t10 = h2.Cells(j, "E")
'DOCUMENTO "N" en kx
doc = Split(h1.Cells(i, "N"), "-")
Exit For
Else
'REFERENCIA "H" en tabla
'INI-REF "T" en kx
If h2.Cells(j, "H") = h1.Cells(i, "T") Then
'T-12 "D" en tabla
t12 = h2.Cells(j, "D")
'T-10 "E" en tabla
t10 = h2.Cells(j, "E")
'REFERENCIA "U" en kx
doc = Split(h1.Cells(i, "U"), "-")
Exit For
End If
End If
End If
End If
Next
'T-12 "S" en kx
h1.Cells(i, "S") = "'" & t12
'T-10 "O" en kx
h1.Cells(i, "O") = "'" & t10
'SERIE "P" en kx
h1.Cells(i, "P") = "'" & doc(1)
'NUMERO "Q" en kx
h1.Cells(i, "Q") = "'" & doc(2)
End If
Next
End SubS a l u d o s . D a n t e A m o r
Recuerda valorar la respuesta.
Dante, funciona en la columna "S", pero no en las columnas "O", "P" y "Q", te envío los dos archivos (el MACRO original y el MACRO con opción eliminar)
Esta es la macro
Sub CompletaKardex()
'Por.Dante Amor
'FUNCIONA OPERACION INGRESO X COMPRA
Set h1 = Sheets("KARDEX")
Set h2 = Sheets("TABLA MOVIMIENTOS")
'TIPO DE MOVIMIENTO "R" en KX
For i = 3 To h1.Range("R" & Rows.Count).End(xlUp).Row
'T-12 CODIGO MOVIMIENTO "S" en KX
If h1.Cells(i, "S") = "" Then
For j = 7 To 20
'TIPO MOVIMIENTO "C" en tabla
'TIPO MOVIMIENTO "R" en KX
If h2.Cells(j, "C") = h1.Cells(i, "R") Then
If h2.Cells(j, "C") = "ELIMINAR" Then
t12 = "00"
t10 = "00"
texto = "00-00-00"
doc = Split(texto, "-")
Else
'REFERENCIA "H" en tabla
If h2.Cells(j, "H") = "vacio" Then
'T-12 "D" en tabla
t12 = h2.Cells(j, "D")
'T-10 "E" en tabla
t10 = h2.Cells(j, "E")
'DOCUMENTO "N" en kx
doc = Split(h1.Cells(i, "N"), "-")
Exit For
Else
'REFERENCIA "H" en tabla
'INI-REF "T" en kx
If h2.Cells(j, "H") = h1.Cells(i, "T") Then
'T-12 "D" en tabla
t12 = h2.Cells(j, "D")
'T-10 "E" en tabla
t10 = h2.Cells(j, "E")
'REFERENCIA "U" en kx
doc = Split(h1.Cells(i, "U"), "-")
Exit For
End If
End If
End If
End If
Next
'T-12 "S" en kx
h1.Cells(i, "S") = "'" & t12
'T-10 "O" en kx
h1.Cells(i, "O") = "'" & t10
'SERIE "P" en kx
h1.Cells(i, "P") = "'" & doc(1)
'NUMERO "Q" en kx
h1.Cells(i, "Q") = "'" & doc(2)
End If
Next
End Sub
