Se dañó el código

10/10/2007 - 13:43 por GRIEGO59 | Informe spam
Tengo un código espectacular que me suministró Hector Miguel en este foro.
Funcionaba muy bien hasta que yo agregué las columnas J,K,L,M,N,O,P,Q.

Cuando intruduzco un serial inexistente me da:
Error 13 en tiempo de ejecución, no coinciden los tipos.

Estuve revisando el código para intentar *ampliar el rango?* pero, la
verdad, no consegí ese rango.

El código que tengo es el siguiente:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Msj As String
If Intersect(Target, Range("e2,b4:b18")) Is Nothing Then Exit Sub
If IsEmpty(Target) Then Exit Sub
With Worksheets("clientes")
If Target.Address <> "$E$2" Then GoTo Seriales
If Not Evaluate("iserror(c2)") Then Exit Sub
If MsgBox("El codigo solicitado: " & Target & " NO existe..." & vbCr & _
"Confirmas que debe darse de alta ?", vbYesNo, _
"Alta de clientes...") = vbNo Then Exit Sub
SendKeys "{down " & Application.CountA(.[a:a]) - 1 & "}" & Target & "{tab}"
.ShowDataForm
.[a:b].Sort Key1:=.[a2], Order1:=xlAscending, Header:=xlYes
Target.Select
Exit Sub
End With
Seriales:
If Application.CountIf([b4:b18], Target) > 1 Then Msj = " esta duplicado !!!"
If Application.VLookup(Target, Worksheets("compras").[a:g], 7, 0) > 0 _
Then Msj = " es un producto YA facturado !!!"
If Msj <> "" Then MsgBox "El serial " & Target & Msj: Target.ClearContents
End Sub

Actualmente el código hace cuatro cosas
1- al escribir en un número de cédula de cliente inexistente en la hoja
"clientes" abre mensaje y pregunta si desea crearlo, y abre formulario para
crearlo.
2- al escribir un serial ya escrito en la hoja actual (hoja "facturadeventa)
abre mensaje y evita el registro.
3- al escribir un serial vendido (según hoja "compras") abre mensaje y evita
el registro.
4- al escribir un serial inexistente (según hoja "compras") abre mensaje de
aviso, y evita el registro. Es aquí donde me da el error al introducir un
serial inexistente.

Información adicional:
Hoja "facturadeventas"
E2 múmero de cédula cliente
C2 Fórmula VBuscar nombre del cliente en hoja "clientes"
B4:B18 seriales vendidos en esa factura
C4:C18 Fórmula Vbuscar descripción del producto en hoja "compras"

Hoja "clientes"
A1 Título Número de cédula cliente
A2 título Nombre cliente

Hoja "compras"
A1 Título Serial del producto
D1 Título Descripción del producto
G1 Título Fecha de venta
H1 Título Número de factura de venta
I1 Título Precio de venta final

Espero que puedan ayudarme por favor y disculpen lo seguido.

Griego59

Preguntas similare

Leer las respuestas

#1 Héctor Miguel
11/10/2007 - 01:07 | Informe spam
hola, Darío !

en el codigo (y la consulta) original no esta contemplada la posibilidad de introducir seriales inexistentes en la factura
(ademas de que no comentas a cual hoja le agregaste columnas, ni cual es el objetivo de las mismas)
y el error se debe a que la funcion (VLookup) obviamente no podra encontrar un codigo que no existe en la hoja "compras"

prueba modificando el codigo a partir de la etiqueta de los Seriales:
de:
If Application.CountIf([b4:b18], Target) > 1 Then Msj = " esta duplicado !!!"
If Application.VLookup(Target, Worksheets("compras").[a:g], 7, 0) > 0 _
Then Msj = " es un producto YA facturado !!!"
If Msj <> "" Then MsgBox "El serial " & Target & Msj: Target.ClearContents

a:
If Application.CountIf([b4:b18], Target) > 1 Then Msj = " esta duplicado !!!"
With Worksheets("compras")
If Application.CountIf(.[a:a], Target) Then
If Application.VLookup(Target, .[a:g], 7, 0) > 0 _
Then Msj = " es un producto YA facturado !!!"
Else
Msj = " no es un serial existente !!!"
End If
End With
If Msj <> "" Then MsgBox "El serial " & Target & Msj: Target.ClearContents

si cualquier duda (o informacion adicional)... comentas ?
saludos,
hector.

__ la consulta original __
Tengo un codigo... que... Funcionaba muy bien hasta que yo agregue las columnas J,K,L,M,N,O,P,Q.
Cuando intruduzco un serial inexistente me da: Error 13 en tiempo de ejecucion, no coinciden los tipos.
Estuve revisando el codigo para intentar *ampliar el rango?* pero, la verdad, no consegi ese rango (...)
Actualmente el codigo hace cuatro cosas
1- al escribir en un numero de cedula de cliente inexistente en la hoja "clientes"
abre mensaje y pregunta si desea crearlo, y abre formulario para crearlo.
2- al escribir un serial ya escrito en la hoja actual (hoja "facturadeventa) abre mensaje y evita el registro.
3- al escribir un serial vendido (segun hoja "compras") abre mensaje y evita el registro.
4- al escribir un serial inexistente (segun hoja "compras") abre mensaje de aviso, y evita el registro.
Es aqui donde me da el error al introducir un serial inexistente.
Informacion adicional:

Hoja "facturadeventas"
E2 mumero de cedula cliente
C2 Formula VBuscar nombre del cliente en hoja "clientes"
B4:B18 seriales vendidos en esa factura
C4:C18 Formula Vbuscar descripcion del producto en hoja "compras"

Hoja "clientes"
A1 Titulo Numero de cedula cliente
A2 titulo Nombre cliente

Hoja "compras"
A1 Titulo Serial del producto
D1 Titulo Descripcion del producto
G1 Titulo Fecha de venta
H1 Titulo Numero de factura de venta
I1 Titulo Precio de venta final



__ el codigo expuesto __
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Msj As String
If Intersect(Target, Range("e2,b4:b18")) Is Nothing Then Exit Sub
If IsEmpty(Target) Then Exit Sub
With Worksheets("clientes")
If Target.Address <> "$E$2" Then GoTo Seriales
If Not Evaluate("iserror(c2)") Then Exit Sub
If MsgBox("El codigo solicitado: " & Target & " NO existe..." & vbCr & _
"Confirmas que debe darse de alta ?", vbYesNo, _
"Alta de clientes...") = vbNo Then Exit Sub
SendKeys "{down " & Application.CountA(.[a:a]) - 1 & "}" & Target & "{tab}"
.ShowDataForm
.[a:b].Sort Key1:=.[a2], Order1:=xlAscending, Header:=xlYes
Target.Select
Exit Sub
End With
Seriales:
If Application.CountIf([b4:b18], Target) > 1 Then Msj = " esta duplicado !!!"
If Application.VLookup(Target, Worksheets("compras").[a:g], 7, 0) > 0 _
Then Msj = " es un producto YA facturado !!!"
If Msj <> "" Then MsgBox "El serial " & Target & Msj: Target.ClearContents
End Sub
Respuesta Responder a este mensaje
#2 GRIEGO59
11/10/2007 - 02:38 | Informe spam
Hola Hector!
Gracias por tu ayuda!
Me sigue dando Error 13 en tiempo de ejecución, no coinciden los tipos : (

Las columnas las agregué a la hoja “compras”
La hoja “compras” estaba hasta la columna “I”
Las columnas agregadas fueron:

J Nombre del Proveedor del producto
K Ganancia presupuestada en Bs
L Ganancia final en Bs
M Diferencia entre ganancia presupuestada y ganancia real en Bs
N Ganancia presupuestada en %
O Ganancia final en %
P Diferencia entre ganancia presupuestada y ganancia real en %
Q Rotación de inventario en días
Todas son fórmulas, menos la columna "J"

Saludos,
Darío


"Héctor Miguel" escribió:

hola, Darío !

en el codigo (y la consulta) original no esta contemplada la posibilidad de introducir seriales inexistentes en la factura
(ademas de que no comentas a cual hoja le agregaste columnas, ni cual es el objetivo de las mismas)
y el error se debe a que la funcion (VLookup) obviamente no podra encontrar un codigo que no existe en la hoja "compras"

prueba modificando el codigo a partir de la etiqueta de los Seriales:
de:
If Application.CountIf([b4:b18], Target) > 1 Then Msj = " esta duplicado !!!"
If Application.VLookup(Target, Worksheets("compras").[a:g], 7, 0) > 0 _
Then Msj = " es un producto YA facturado !!!"
If Msj <> "" Then MsgBox "El serial " & Target & Msj: Target.ClearContents

a:
If Application.CountIf([b4:b18], Target) > 1 Then Msj = " esta duplicado !!!"
With Worksheets("compras")
If Application.CountIf(.[a:a], Target) Then
If Application.VLookup(Target, .[a:g], 7, 0) > 0 _
Then Msj = " es un producto YA facturado !!!"
Else
Msj = " no es un serial existente !!!"
End If
End With
If Msj <> "" Then MsgBox "El serial " & Target & Msj: Target.ClearContents

si cualquier duda (o informacion adicional)... comentas ?
saludos,
hector.

__ la consulta original __
> Tengo un codigo... que... Funcionaba muy bien hasta que yo agregue las columnas J,K,L,M,N,O,P,Q.
> Cuando intruduzco un serial inexistente me da: Error 13 en tiempo de ejecucion, no coinciden los tipos.
> Estuve revisando el codigo para intentar *ampliar el rango?* pero, la verdad, no consegi ese rango (...)
> Actualmente el codigo hace cuatro cosas
> 1- al escribir en un numero de cedula de cliente inexistente en la hoja "clientes"
> abre mensaje y pregunta si desea crearlo, y abre formulario para crearlo.
> 2- al escribir un serial ya escrito en la hoja actual (hoja "facturadeventa) abre mensaje y evita el registro.
> 3- al escribir un serial vendido (segun hoja "compras") abre mensaje y evita el registro.
> 4- al escribir un serial inexistente (segun hoja "compras") abre mensaje de aviso, y evita el registro.
> Es aqui donde me da el error al introducir un serial inexistente.
> Informacion adicional:
>
> Hoja "facturadeventas"
> E2 mumero de cedula cliente
> C2 Formula VBuscar nombre del cliente en hoja "clientes"
> B4:B18 seriales vendidos en esa factura
> C4:C18 Formula Vbuscar descripcion del producto en hoja "compras"
>
> Hoja "clientes"
> A1 Titulo Numero de cedula cliente
> A2 titulo Nombre cliente
>
> Hoja "compras"
> A1 Titulo Serial del producto
> D1 Titulo Descripcion del producto
> G1 Titulo Fecha de venta
> H1 Titulo Numero de factura de venta
> I1 Titulo Precio de venta final
>
__ el codigo expuesto __
> Private Sub Worksheet_Change(ByVal Target As Range)
> Dim Msj As String
> If Intersect(Target, Range("e2,b4:b18")) Is Nothing Then Exit Sub
> If IsEmpty(Target) Then Exit Sub
> With Worksheets("clientes")
> If Target.Address <> "$E$2" Then GoTo Seriales
> If Not Evaluate("iserror(c2)") Then Exit Sub
> If MsgBox("El codigo solicitado: " & Target & " NO existe..." & vbCr & _
> "Confirmas que debe darse de alta ?", vbYesNo, _
> "Alta de clientes...") = vbNo Then Exit Sub
> SendKeys "{down " & Application.CountA(.[a:a]) - 1 & "}" & Target & "{tab}"
> .ShowDataForm
> .[a:b].Sort Key1:=.[a2], Order1:=xlAscending, Header:=xlYes
> Target.Select
> Exit Sub
> End With
> Seriales:
> If Application.CountIf([b4:b18], Target) > 1 Then Msj = " esta duplicado !!!"
> If Application.VLookup(Target, Worksheets("compras").[a:g], 7, 0) > 0 _
> Then Msj = " es un producto YA facturado !!!"
> If Msj <> "" Then MsgBox "El serial " & Target & Msj: Target.ClearContents
> End Sub



Respuesta Responder a este mensaje
#3 Héctor Miguel
11/10/2007 - 03:38 | Informe spam
hola, Darío !

Me sigue dando Error 13 en tiempo de ejecucion, no coinciden los tipos :(
Las columnas las agregue a la hoja "compras"... estaba hasta la columna "I"
Las columnas agregadas fueron:
J Nombre del Proveedor del producto
K Ganancia presupuestada en Bs
L Ganancia final en Bs
M Diferencia entre ganancia presupuestada y ganancia real en Bs
N Ganancia presupuestada en %
O Ganancia final en %
P Diferencia entre ganancia presupuestada y ganancia real en %
Q Rotacion de inventario en dias
Todas son formulas, menos la columna "J"



1) el codigo solo utiliza para la busqueda en la hoja "compras" las columnas A <-> G
lo que hagas a partir de la columna H no le deberia de afectar -???-

2) con las modificaciones de la propuesta anterior, me ha funcionado sin el error que comentas -?-
te paso el codigo completo al final del presente

si cualquier duda (o informacion adicional)... comentas ?
saludos,
hector.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Msj As String
If Intersect(Target, Range("e2,b4:b18")) Is Nothing Then Exit Sub
If IsEmpty(Target) Then Exit Sub
With Worksheets("clientes")
If Target.Address <> "$E$2" Then GoTo Seriales
If Not Evaluate("iserror(c2)") Then Exit Sub
If MsgBox("El codigo solicitado: " & Target & " NO existe..." & vbCr & _
"Confirmas que debe darse de alta ?", vbYesNo, _
"Alta de clientes...") = vbNo Then Exit Sub
SendKeys "{down " & Application.CountA(.[a:a]) - 1 & "}" & Target & "{tab}"
.ShowDataForm
.[a:b].Sort Key1:=.[a2], Order1:=xlAscending, Header:=xlYes
Target.Select
Exit Sub
End With
Seriales:
If Application.CountIf([b4:b18], Target) > 1 Then Msj = " esta duplicado !!!"
With Worksheets("compras")
If Application.CountIf(.[a:a], Target) Then
If Application.VLookup(Target, .[a:g], 7, 0) > 0 _
Then Msj = " es un producto YA facturado !!!"
Else
Msj = " no es un serial existente !!!"
End If
End With
If Msj <> "" Then MsgBox "El serial " & Target & Msj: Target.ClearContents
End Sub
Respuesta Responder a este mensaje
#4 GRIEGO59
11/10/2007 - 04:28 | Informe spam
Parce que cuando introduzco seriales con tres o menos dígitos da error 13 y
sobresalta estas líneas del código. Del resto funciona espectacular:

If Application.VLookup(Target, .[a:g], 7, 0) > 0 _
Then

Mis códigos tienen formato “texto”.

Gracias
Hector

"Héctor Miguel" escribió:

hola, Darío !

> Me sigue dando Error 13 en tiempo de ejecucion, no coinciden los tipos :(
> Las columnas las agregue a la hoja "compras"... estaba hasta la columna "I"
> Las columnas agregadas fueron:
> J Nombre del Proveedor del producto
> K Ganancia presupuestada en Bs
> L Ganancia final en Bs
> M Diferencia entre ganancia presupuestada y ganancia real en Bs
> N Ganancia presupuestada en %
> O Ganancia final en %
> P Diferencia entre ganancia presupuestada y ganancia real en %
> Q Rotacion de inventario en dias
> Todas son formulas, menos la columna "J"

1) el codigo solo utiliza para la busqueda en la hoja "compras" las columnas A <-> G
lo que hagas a partir de la columna H no le deberia de afectar -???-

2) con las modificaciones de la propuesta anterior, me ha funcionado sin el error que comentas -?-
te paso el codigo completo al final del presente

si cualquier duda (o informacion adicional)... comentas ?
saludos,
hector.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Msj As String
If Intersect(Target, Range("e2,b4:b18")) Is Nothing Then Exit Sub
If IsEmpty(Target) Then Exit Sub
With Worksheets("clientes")
If Target.Address <> "$E$2" Then GoTo Seriales
If Not Evaluate("iserror(c2)") Then Exit Sub
If MsgBox("El codigo solicitado: " & Target & " NO existe..." & vbCr & _
"Confirmas que debe darse de alta ?", vbYesNo, _
"Alta de clientes...") = vbNo Then Exit Sub
SendKeys "{down " & Application.CountA(.[a:a]) - 1 & "}" & Target & "{tab}"
.ShowDataForm
.[a:b].Sort Key1:=.[a2], Order1:=xlAscending, Header:=xlYes
Target.Select
Exit Sub
End With
Seriales:
If Application.CountIf([b4:b18], Target) > 1 Then Msj = " esta duplicado !!!"
With Worksheets("compras")
If Application.CountIf(.[a:a], Target) Then
If Application.VLookup(Target, .[a:g], 7, 0) > 0 _
Then Msj = " es un producto YA facturado !!!"
Else
Msj = " no es un serial existente !!!"
End If
End With
If Msj <> "" Then MsgBox "El serial " & Target & Msj: Target.ClearContents
End Sub



Respuesta Responder a este mensaje
#5 GRIEGO59
11/10/2007 - 04:29 | Informe spam
Fe de errarata
Mis seriales tienen formato de texto
Saludos
Darío

"Héctor Miguel" escribió:

hola, Darío !

> Me sigue dando Error 13 en tiempo de ejecucion, no coinciden los tipos :(
> Las columnas las agregue a la hoja "compras"... estaba hasta la columna "I"
> Las columnas agregadas fueron:
> J Nombre del Proveedor del producto
> K Ganancia presupuestada en Bs
> L Ganancia final en Bs
> M Diferencia entre ganancia presupuestada y ganancia real en Bs
> N Ganancia presupuestada en %
> O Ganancia final en %
> P Diferencia entre ganancia presupuestada y ganancia real en %
> Q Rotacion de inventario en dias
> Todas son formulas, menos la columna "J"

1) el codigo solo utiliza para la busqueda en la hoja "compras" las columnas A <-> G
lo que hagas a partir de la columna H no le deberia de afectar -???-

2) con las modificaciones de la propuesta anterior, me ha funcionado sin el error que comentas -?-
te paso el codigo completo al final del presente

si cualquier duda (o informacion adicional)... comentas ?
saludos,
hector.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Msj As String
If Intersect(Target, Range("e2,b4:b18")) Is Nothing Then Exit Sub
If IsEmpty(Target) Then Exit Sub
With Worksheets("clientes")
If Target.Address <> "$E$2" Then GoTo Seriales
If Not Evaluate("iserror(c2)") Then Exit Sub
If MsgBox("El codigo solicitado: " & Target & " NO existe..." & vbCr & _
"Confirmas que debe darse de alta ?", vbYesNo, _
"Alta de clientes...") = vbNo Then Exit Sub
SendKeys "{down " & Application.CountA(.[a:a]) - 1 & "}" & Target & "{tab}"
.ShowDataForm
.[a:b].Sort Key1:=.[a2], Order1:=xlAscending, Header:=xlYes
Target.Select
Exit Sub
End With
Seriales:
If Application.CountIf([b4:b18], Target) > 1 Then Msj = " esta duplicado !!!"
With Worksheets("compras")
If Application.CountIf(.[a:a], Target) Then
If Application.VLookup(Target, .[a:g], 7, 0) > 0 _
Then Msj = " es un producto YA facturado !!!"
Else
Msj = " no es un serial existente !!!"
End If
End With
If Msj <> "" Then MsgBox "El serial " & Target & Msj: Target.ClearContents
End Sub



Respuesta Responder a este mensaje
Ads by Google
Help Hacer una preguntaSiguiente Respuesta Tengo una respuesta
Search Busqueda sugerida