UniversoExcelForo

Respuesta a consultas.
Fecha de creación: 09.Abril.2012

Fundadores: Wibly,Tyno,Servando,Sakkar,Rosendo2,RMaximo,Railar,Mcoronel,Ioyama,Igtelo,Hugotron,Drochar,Dedos,Alberto,Adolfo

No se pueden hacer consultas de Excel o VBA por mensaje privado.
Utiliza el botón buscar del foro y te ahorras tiempo para obtener "ayuda".

No estás conectado. Conéctate o registrate

Ver el tema anterior Ver el tema siguiente Ir abajo  Mensaje [Página 1 de 1.]

1 Error '13' el 27/11/12, 10:58 pm

Mysterio


Hola!
Estoy trabajando con una macro que adecue en la medida de lo posible a mis nencesidades, habia estado funcionando bien hasta que aparecio este error donde dice que no coinciden los tipos; la macro es la siguiente:
Sub Registrar_Extracción()

Sheets("Surtido").Select
ActiveSheet.Unprotect
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Range("A2:O65536").Select
Selection.ClearContents
Range("A2").Select
Sheets("Kardex").Select
ActiveSheet.Unprotect
li = 2
li3 = 1
Ini:
If Cells(li, 1) = "" Then GoTo Saldo
Cells(li3, 19) = Cells(li, 17)
li = li + 1
GoTo Ini:
Saldo:
Sheets("Saldo").Select
ActiveSheet.Unprotect
li = 4
li2 = 4
li3 = 1
Cont = 2
If Cells(li2, 32) = "" Then GoTo Fin
Folio:
If Cells(li2, 32) = "" Then GoTo Valores
Cells(li2, 35) = Sheets("Kardex").Cells(li3, 20) + 1
Cells(li2, 35) = Cells(li2, 35) & "a"
li2 = li2 + 1
GoTo Folio
Valores:
li2 = 4
Valores2:
If Cells(li2, 32) = "" Then GoTo Valida
If Cells(li2, 34) <> "" Then GoTo Pas
Cells(li2, 34) = "0"
Pas:
li2 = li2 + 1
GoTo Valores2
Valida:
li = 4
li2 = 4
Validación:
If Cells(li2, 20) = "" Then GoTo Fin

If Cells(li2, 19) = Cells(li, 1) And Cells(li2, 20) = Cells(li, 2) And Cells(li2, 21) = Cells(li, 3) And Cells(li2, 22) = Cells(li, 4) And Cells(li2, 23) = Cells(li, 5) And Cells(li2, 24) = Cells(li, 6) And Cells(li2, 25) = Cells(li, 7) And Cells(li2, 26) = Cells(li, Cool And Cells(li2, 27) = Cells(li, 9) And Cells(li2, 28) = Cells(li, 10) And Cells(li2, 29) = Cells(li, 11) And Cells(li2, 30) = Cells(li, 12) Then GoTo Inicio
li = li + 1
GoTo Validación:
Inicio:
If Cells(li, 1) = "" Then GoTo Fin
If Cells(li2, 20) = Cells(li, 2) And Cells(li2, 21) = Cells(li, 3) And Cells(li2, 22) = Cells(li, 4) And Cells(li2, 23) = Cells(li, 5) And Cells(li2, 24) = Cells(li, 6) And Cells(li2, 25) = Cells(li, 7) And Cells(li2, 26) = Cells(li, Cool And Cells(li2, 27) = Cells(li, 9) And Cells(li2, 28) = Cells(li, 10) And Cells(li2, 29) = Cells(li, 11) And Cells(li2, 30) = Cells(li, 12) Then GoTo Registrar
li = li + 1
GoTo Inicio:
Registrar:
If Val(Cells(li2, 34)) > Val(Cells(li, 15)) Then GoTo MSG5
Cells(li, 15) = Val(Cells(li, 15)) - Cells(li2, 34)
li2 = li2 + 1
GoTo Validación:
MSG5:
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
MsgBox "La cantidad que se intenta descontar, es mayor al saldo", vbInformation
Exit Sub
GoTo Fin:
MSG6:
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
MsgBox "No se encontraron Datos que concuerden en Ubicación y Código", vbInformation
Exit Sub
GoTo Fin:
Fin:
li = 1
Sheets("Saldo").Select
li2 = 4
Registra:
If Cells(li2, 34) = "" Then GoTo Final
If Cells(li2, 34) = "0" Then GoTo Conta
GoTo Com:
Verifica:
li = li + 1
Com:
Sheets("Kardex").Select
If Cells(li, 1) <> "" Then GoTo Verifica
Cells(li, 1) = Date
Cells(li, 2) = Sheets("Saldo").Cells(li2, 19)
' Cells(li, 3) = Sheets("Saldo").Cells(li2, 20)
Cells(li, 3) = "SAL-OV"
Cells(li, 4) = Sheets("Saldo").Cells(li2, 21)
Cells(li, 5) = Sheets("Saldo").Cells(li2, 22)
Cells(li, 6) = Sheets("Saldo").Cells(li2, 23)
Cells(li, 7) = Sheets("Saldo").Cells(li2, 24)
Cells(li, Cool = Sheets("Saldo").Cells(li2, 25)
Cells(li, 9) = Sheets("Saldo").Cells(li2, 26)
Cells(li, 10) = Sheets("Saldo").Cells(li2, 27)
' Cells(li, 11) = Sheets("Saldo").Cells(li2, 28)
Cells(li, 11) = 1
Cells(li, 12) = Sheets("Saldo").Cells(li2, 29)
Cells(li, 13) = Sheets("Saldo").Cells(li2, 30)
Cells(li, 14) = Sheets("Saldo").Cells(li2, 31)
Cells(li, 15) = Sheets("Saldo").Cells(li2, 32)
Cells(li, 16) = Sheets("Saldo").Cells(li2, 34)
Cells(li, 17) = Sheets("Saldo").Cells(li2, 35)
Cells(li, 18) = Sheets("Saldo").Cells(li2, 36)

Sheets("Surtido").Select
If Cells(li, 1) <> "" Then GoTo Verifica
Cells(Cont, 1) = Sheets("Saldo").Cells(li2, 19)
Cells(Cont, 2) = Sheets("Saldo").Cells(li2, 20)
Cells(Cont, 3) = Sheets("Saldo").Cells(li2, 21)
Cells(Cont, 4) = Sheets("Saldo").Cells(li2, 22)
Cells(Cont, 5) = Sheets("Saldo").Cells(li2, 23)
Cells(Cont, 6) = Sheets("Saldo").Cells(li2, 24)
Cells(Cont, 7) = Sheets("Saldo").Cells(li2, 25)
Cells(Cont, Cool = Sheets("Saldo").Cells(li2, 26)
Cells(Cont, 9) = Sheets("Saldo").Cells(li2, 27)
Cells(Cont, 10) = Sheets("Saldo").Cells(li2, 28)
Cells(Cont, 11) = Sheets("Saldo").Cells(li2, 29)
Cells(Cont, 12) = Sheets("Saldo").Cells(li2, 30)
Cells(Cont, 13) = Sheets("Saldo").Cells(li2, 31)
Cells(Cont, 14) = Sheets("Saldo").Cells(li2, 32)
Cells(Cont, 15) = Sheets("Saldo").Cells(li2, 34)
Cells(Cont, 16) = Sheets("Saldo").Cells(li2, 35)
Cells(Cont, 17) = Sheets("Saldo").Cells(li2, 36)
Cont = Cont + 1
Sheets("Saldo").Select
Conta:
li2 = li2 + 1
GoTo Registra:
Final:
Sheets("Saldo").Select
Range("AI4:AJ65536").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
Range("S4:AG4").Select
Range(Selection, Selection.End(xlUp)).Select
Range("S4:AH5").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Interior.ColorIndex = xlNone
Selection.ClearContents
'Filtrar Datos
Range("AC2").Select
Range("A3:O65536").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
Range("S1:AG2"), CopyToRange:=Range("S3:AG3"), Unique:=False
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
' MsgBox "Se concluyó el proceso de registro de datos", vbInformation
Exit Sub
End Sub

Si me pueden ayudar se los voy a agradecer mucho..

Saludos

2 Re: Error '13' el 29/11/12, 09:09 pm

Igtelo


Hola Mysterio.

Viendo tu código me parece que te manda error por la parte final, en el filtrado, como no hay archivo me es difícil entender lo que hace tu hoja.

Vamos a intentar así:

1.- Tu código:

GoTo Registra:
Final:
Sheets("Saldo").Select
Range("AI4:AJ65536").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
Range("S4:AG4").Select
Range(Selection, Selection.End(xlUp)).Select
Range("S4:AH5").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Interior.ColorIndex = xlNone
Selection.ClearContents
'Filtrar Datos
Range("AC2").Select
Range("A3:O65536").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
Range("S1:AG2"), CopyToRange:=Range("S3:AG3"), Unique:=False
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
' MsgBox "Se concluyó el proceso de registro de datos", vbInformation
Exit Sub
End Sub


Cámbialo por éste:
Spoiler:
GoTo Registra:
Final:
Sheets("Saldo").Select
Range("AI4:AJ65536").ClearContents
Range("S4:AH65536").Select
Selection.Interior.ColorIndex = xlNone
Selection.ClearContents

'Filtrar Datos
Range("AC2").Select
Range("A3:O10000").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
Range("S1:AG2"), CopyToRange:=Range("S3:AG3"), Unique:=False
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
MsgBox "Se concluyó el proceso de registro de datos", vbInformation
Exit Sub
End Sub
En teoría ya no debe haber problema.

2.- Ahora, para la parte inicial, aunque no influye, está de más tanta instrucción.

Sustituye esto:

Sheets("Surtido").Select
ActiveSheet.Unprotect
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Range("A2:O65536").Select
Selection.ClearContents
Range("A2").Select

Por esto:
Spoiler:
Sheets("Surtido").Select
ActiveSheet.Unprotect
Range("A2:O65536").ClearContents
Range("A2").Select

Prueba en "UNA COPIA" de tu archivo, si ya te jala bien lo haces en el original.

Si después de esto no funciona, sube tu archivo y ya le encontramos.

Saludos
Ignacio Téllez
P.D: Para ver el código, click sobre Spoiler.







3 Error '13' el 30/11/12, 07:47 pm

Mysterio


Hola!
Subo el archivo...

Ver el tema anterior Ver el tema siguiente Volver arriba  Mensaje [Página 1 de 1.]

Permisos de este foro:
No puedes responder a temas en este foro.