Cambiar datos en hoja con eventos de otra

11/03/2006 - 04:40 por klomkbock | Informe spam
Hola a todos

Estoy intentando que con eventos del modulo de una hoja me cambie
determinados datos de esta y de otra hoja del mismo libro. Lo he intentado
con SelctedChange y con Change a secas pero no hay manera. He intentado
adaptar el codigo que en un modulo normal funciona bien pero me topo con
algo que produce disparates,o, como ahora mismo, directamente no hace nada.

DISCULPAD, PERO HE DADO AL INTRO SIN QUERER Y CREO QUE YA LLEVO POR LO
MENOS DOS MENSAJES.

Continúo. Se trata de un libro con dos hojas. En el ejemplo, en la primera
hay una lista de articulos con referencia unica y los stocks de tienda,
almacen(en este ejemplo no interviene para nada), taras y variacion de
stock en tienda(columnas A; B; C; D; G), nombre de articulo y PVP (col. E;
F). En la segunda hoja, que haria la funcion de formulario, estarian los
campos: Ref, Vendidos, Devueltos, Baja, Articulos y PVP, columnas A; B; C;
D; E y F respectivamente.
Lo que intento es que al introducir en la columna A de la 2ª hoja la Ref
del articulo me ponga en las columnas E y F el nombre y el Pvp, y que a la
vez me reste al stock de tienda en la hoja 1 las cantidades vendidas y las
bajas, y que me añada a este stock de tienda las devueltas y al de taras
las bajas. En la hoja 2 (formulario) pueden repetirse los registro y
normalmente solo "usan" uno de los campos (vendido, devuelto y baja
normalmente solo).
Bueno no se si me he explicado ni si podreis ayudarme, pero por si acaso
hay va el ultimo codigo que he intentado y el que me funciona ejecutandolo
desde un modulo normal.

Muchas gracias de antemano.

Un saludo y hasta pronto.
Ivan

Private Sub Worksheet_Change(ByVal Target As Range)
Dim prueba_ventas As Workbook
Dim Inventario As Worksheet, Ventas As Worksheet
Dim Celda As Range, Ref_I As Range
Set prueba_ventas = Application.Workbooks("prueba ventas.xls")
Set Inventario = prueba_ventas.Sheets("Hoja1")
Set Ventas = prueba_ventas.Sheets("Hoja2")
Set Ref_I = Inventario.Range("a2:a20")
Dim i As Integer
Application.ScreenUpdating = False
For Each Celda In Ref_I
With Celda
If Target.Column = i Then
Select Case i
Case 1
If .Value = Target Then _
Target.Offset(, 4) = .Offset(, 4) And _
Target.Offset(, 5) = .Offset(, 5)
Case 2
.Offset(, 1) = .Offset(, 1) - Target
.Offset(, 6) = -Target
Case 3
.Offset(, 1) = .Offset(, 1) + Target
.Offset(, 6) = .Offset(, 6) + Target
Case 4
.Offset(, 1) = .Offset(, 1) - Target
.Offset(, 3) = .Offset(, 3) + Target
End Select
End If
End With
Next Celda
End Sub



Sub CopiarDatos()
Set prueba_ventas = Application.Workbooks("prueba ventas.xls")
Set Inventario = prueba_ventas.Sheets("Hoja1")
Set Ventas = prueba_ventas.Sheets("Hoja2")
Set Inv1 = Inventario.Range("a2:a20")
Set Inv2 = Ventas.Range("a2:a20")
Application.ScreenUpdating = False

For Each Celda2 In Inv2
Ref2 = Celda2
For Each Celda1 In Inv1
Ref1 = Celda1
If Ref2 = Ref1 And IsNumeric(Celda2.Offset(, 1)) _
And IsNumeric(Celda2.Offset(, 3)) Then
With Celda2
.Offset(, 4) = Celda1.Offset(, 4)
.Offset(, 5) = Celda1.Offset(, 5)
End With
With Celda1

.Offset(, 1) = .Offset(, 1) - Celda2.Offset(, 1)
.Offset(, 6) = .Offset(, 6) - Celda2.Offset(, 1)
.Offset(, 1) = .Offset(, 1) + Celda2.Offset(, 2)
.Offset(, 6) = .Offset(, 6) + Celda2.Offset(, 2)
.Offset(, 1) = .Offset(, 1) - Celda2.Offset(, 3)
.Offset(, 6) = .Offset(, 6) - Celda2.Offset(, 3)
.Offset(, 3) = .Offset(, 3) + Celda2.Offset(, 3)
End With
End If
Next Celda1
Next Celda2


End Sub

Preguntas similare

Leer las respuestas

#1 Francisco GMAIL
11/03/2006 - 06:01 | Informe spam
Ya intentaste usar la barra de herramientas de formularios que se puede
utilizar dentro de excel, con esa barra me ha tocado ver
ejemplos de lo que buscas.

Saludos

Francisco

Respuesta Responder a este mensaje
#2 Héctor Miguel
11/03/2006 - 08:04 | Informe spam
hola, Ivan !

... intentando que con eventos del modulo de una hoja me cambie... datos de esta y de otra hoja del mismo libro
... con SelctedChange y con Change a secas pero no hay manera
... adaptar el codigo que en un modulo normal funciona bien pero me topo con algo que produce disparates
... o, como ahora mismo, directamente no hace nada.
... por si acaso hay va el ultimo codigo que he intentado y el que me funciona ejecutandolo desde un modulo normal...



si el codigo 'normal' SI funciona... PERO... al 'convertirlo' a codigo de eventos FALLA... [comentarios NO 'com/probados'] :-(

1) en el evento declaras una variable [Dim i As Integer] que se inicializa -> EN CERO por omision [si embargo]...
dado que NO le asignas un 'valor inicial'... la linea -> If Target.Column = i Then -> NO PUEDE 'evaluar' una columna-CERO inicial
[por lo tanto]... los 'casos' [Select Case i] TAMPOCO son 'operables'

2) [creo que] no son necesarias 'tantas' variables de objeto NI sus asignaciones...
-> como Set prueba_ventas = Application.Workbooks("prueba ventas.xls")
-> ademas de que al estar en un modulo de eventos, se estan re/asignando -> en cada 'disparo' del evento
y como no estas 'vaciando' sus asignaciones... corres el riesgo de un -posible- 'cuelgue' de la aplicacion :-((
-> si [en verdad] requieres tales asignaciones... -> muevelas a un modulo 'normal' y 'asignalas' en el evento '_open' del libro ;)

3) [aparentemente] en el caso1 'se trata' de modificar DOS celdas... PERO...
-> estas usando el operador de comparacion 'And' [en lugar de un carcacter -vba- de 'salto y continuacion de linea' ->: _<-]

4) no he comprobado si la 'distribucion' de acuerdo a la columna entre el Target y 'la Celda' [en la conversion a eventos]...
se corresponde con los 'movimientos' que haces con el modulo 'normal' -???-
-> asumiendo que son correctas... prueba con ligeros cambios en el codigo que expones [en el evento]...

si cualquier duda [o informacion adicional]... comentas ?
saludos,
hector.

=los cambios [NO com/probados] al codigo en el modulo de eventos de la hoja 'correspondiente' -???-
=Private Sub Worksheet_Change(ByVal Target As Range)
Dim Celda As Range
For Each Celda In Workbooks("prueba ventas.xls").Worksheets("Hoja1").Range("a2:a20")
With Celda
Select Case Target.Column
Case 1
If .Value = Target Then _
Target.Offset(, 4) = .Offset(, 4): _
Target.Offset(, 5) = .Offset(, 5)
Case 2
.Offset(, 1) = .Offset(, 1) - Target
.Offset(, 6) = -Target
Case 3
.Offset(, 1) = .Offset(, 1) + Target
.Offset(, 6) = .Offset(, 6) + Target
Case 4
.Offset(, 1) = .Offset(, 1) - Target
.Offset(, 3) = .Offset(, 3) + Target
End Select
End With
Next
End Sub

__ el codigo expuesto __
Private Sub Worksheet_Change(ByVal Target As Range)
Dim prueba_ventas As Workbook
Dim Inventario As Worksheet, Ventas As Worksheet
Dim Celda As Range, Ref_I As Range
Set prueba_ventas = Application.Workbooks("prueba ventas.xls")
Set Inventario = prueba_ventas.Sheets("Hoja1")
Set Ventas = prueba_ventas.Sheets("Hoja2")
Set Ref_I = Inventario.Range("a2:a20")
Dim i As Integer
Application.ScreenUpdating = False
For Each Celda In Ref_I
With Celda
If Target.Column = i Then
Select Case i
Case 1
If .Value = Target Then _
Target.Offset(, 4) = .Offset(, 4) And _
Target.Offset(, 5) = .Offset(, 5)
Case 2
.Offset(, 1) = .Offset(, 1) - Target
.Offset(, 6) = -Target
Case 3
.Offset(, 1) = .Offset(, 1) + Target
.Offset(, 6) = .Offset(, 6) + Target
Case 4
.Offset(, 1) = .Offset(, 1) - Target
.Offset(, 3) = .Offset(, 3) + Target
End Select
End If
End With
Next Celda
End Sub

Sub CopiarDatos()
Set prueba_ventas = Application.Workbooks("prueba ventas.xls")
Set Inventario = prueba_ventas.Sheets("Hoja1")
Set Ventas = prueba_ventas.Sheets("Hoja2")
Set Inv1 = Inventario.Range("a2:a20")
Set Inv2 = Ventas.Range("a2:a20")
Application.ScreenUpdating = False
For Each Celda2 In Inv2
Ref2 = Celda2
For Each Celda1 In Inv1
Ref1 = Celda1
If Ref2 = Ref1 And IsNumeric(Celda2.Offset(, 1)) _
And IsNumeric(Celda2.Offset(, 3)) Then
With Celda2
.Offset(, 4) = Celda1.Offset(, 4)
.Offset(, 5) = Celda1.Offset(, 5)
End With
With Celda1
.Offset(, 1) = .Offset(, 1) - Celda2.Offset(, 1)
.Offset(, 6) = .Offset(, 6) - Celda2.Offset(, 1)
.Offset(, 1) = .Offset(, 1) + Celda2.Offset(, 2)
.Offset(, 6) = .Offset(, 6) + Celda2.Offset(, 2)
.Offset(, 1) = .Offset(, 1) - Celda2.Offset(, 3)
.Offset(, 6) = .Offset(, 6) - Celda2.Offset(, 3)
.Offset(, 3) = .Offset(, 3) + Celda2.Offset(, 3)
End With
End If
Next Celda1
Next Celda2
End Sub
Respuesta Responder a este mensaje
#3 Francisco GMAIL
12/03/2006 - 02:25 | Informe spam
Por que no mejor mandas el archivo de muestra y podramos hacer alguna
pruebas con el mismo.

Saludos
Respuesta Responder a este mensaje
#4 klomkbock
12/03/2006 - 04:20 | Informe spam
Hola Héctor Miguel, una vez mas muchas gracias ( hola Francisco, muchas
gracias también a ti, le echare un ojo a esa barra).

Como siempre tus apreciaciones son totalmente útiles, aunque no estoy
seguro de entender del todo el manejo de la “inicialización de las
variables”. No parece que se haga siempre, ¿o es que en muchos casos se
hace implícitamente al asignarle el primer valor real?¿es especialmente
importante en los eventos?... en fin, es larga la tarea…

En cuanto al exceso de variables, la verdad es ya lo había imaginado, de
hecho mi primer código era muy similar al tuyo incluso en el resultado que
me daba, pero me he ido liando, añadiendo cosas, alargándolo,
alargándolo,… y luego, en mi exasperación no me he parado a mirarlo
demasiado y lo he enviado tal cual. Supongo que jugar con los “eventos”
desde la ignorancia no debe ser demasiado bueno para la estabilidad
mental….

Volviendo al código, y si me permites abusar de tu/vuestra generosidad, te
comento un poco hasta donde he llegado.
El código rectificado me seguía dando errores (supongo que mi trasvase
desde el código del modulo normal no era muy acertado), creo que rellena
todos los registros relacionados de la hoja 1 con el ultimo grupo de
Target (o con el primero). Pero lo he vuelto a estirar y he conseguido que
funcione más o menos bien, aunque supongo que el resultado (aparte de unas
cuantas carencias, algunas de las cuales te consulto a continuación) deja
mucho que desear y le sobran muchas cosas.
Respecto a las carencias, la primera de ellas es que me interesa borrar
todos los registros de la Hoja2 antes de introducir los datos. Lo he
intentado en el modulo de la hoja pero no lo he conseguido. Al final he
creado un código con el evento open de ThisWorkbook, y me funciona bien,
pero cuando le doy a vbSi del msgBox que me pregunta si quiero borrar, lo
borra pero provoca un error 13 –no coinciden los tipos- en el case 1 del
modulo de la hoja2, que no llego a descifrar (si estoy en la hoja y le doy
a finalizar en vez de a depurar, borra los campos y me permite trabajar
con normalidad en la hoja). He intentado con tratamiento de errores, pero
creo que tampoco he conseguido todavía comprender del todo su uso, y no me
ha servido. Por otro lado he introducido mil y un bucles Do..Loop que
probablemente no sean necesarios pero de momento es la única forma en que
he conseguido que funcione.
Por otro lado he intentado que me avisara si la Ref. del articulo no
existe, pero los “Changes” casi me vuelven loco otra vez (y al ordenador).
Aunque supongo que esto no debe ser demasiado complicado
(paciencia….empezar un poquito mas fresco?). Carencias quedan muchas, pero
supongo que tampoco es plan.

Bueno ya me he vuelto a enrollar. Si me puedes echar una mano con lo del
borrado (y con lo que te parezca) te lo agradezco, bueno la verdad es que
te lo agradezco en cualquier caso.

A continuación expongo los dos códigos mencionados.

Un saludo y hasta pronto.
Ivan



Private Sub Worksheet_Change(ByVal Target As Range)
Dim celda As Range
For Each celda In Workbooks("prueba ventas.xls") _
.Worksheets("Hoja1").Range("a2:a2000")
If Target.Row > 1 Then
With celda
Select Case Target.Column
Case 1
Do
If Target = 0 Then
Exit Do
ElseIf Target = "" Then
Exit Do
ElseIf .Value = Target Then
Target.Offset(, 4) = .Offset(, 4)
Target.Offset(, 5) = .Offset(, 5)
Exit Do
Else
Exit Do
End If
Loop While Target = .Value
Case 2
Do While Target.Offset(, -1) = .Value
If Target = 0 Then Exit Do
If Target = "" Then Exit Do
.Offset(, 1) = .Offset(, 1) - Target
Target.Offset(, 5) = 0 - Target
If Target.Offset(, -1) = .Value Then Exit Do
Loop
Case 3
Do While Target.Offset(, -2) = .Value
If Target = 0 Then Exit Do
If Target = "" Then Exit Do
.Offset(, 1) = .Offset(, 1) + Target
Target.Offset(, 4) = Target.Offset(, 4) + Target
If Target.Offset(, -2) = .Value Then Exit Do
Loop
Case 4
Do While Target.Offset(, -3) = .Value
If Target = 0 Then Exit Do
If Target = "" Then Exit Do
.Offset(, 1) = .Offset(, 1) - Target
.Offset(, 3) = .Offset(, 3) + Target
Target.Offset(, 3) = Target.Offset(, 3) - Target
If Target.Offset(, -3) = .Value Then Exit Do
Loop
End Select
End With
End If
Next celda
End Sub


Private Sub Workbook_Open()
Dim celda As Range, x As String
With Workbooks("prueba ventas.xls") _
.Worksheets("Hoja2")
.Activate
x = MsgBox("¿Quieres borrar los registros" & _
" anteriores?", vbYesNo, "Borrar registros")
If x = vbYes Then
.Range(Range("a2"), _
Range("g2").End(xlDown).Address) _
.ClearContents
.Range("a2").Select
Else
.Range("a2").Select
End If
End With
End Sub
Respuesta Responder a este mensaje
#5 klomkbock
12/03/2006 - 04:29 | Informe spam
Hola Francisco, muchas gracias por todo.

Acabo de enviar una respuesta via post de HM a la que puedes echar un
vistazo.
En realidad el archivo es de momento basicamente eso, un par de hojas (son
para probar el codigo) de un mismo libro con los campos expuestos en mi
primera consulta (mas o menos) aunque al final la distribucion y la
cantidad seguramente sera bastante diferente (y los procedimientos). En
cualquier caso si despues de echar un vistazo al post sigues interesado te
mando el archivo.

Muchas gracias de nuevo y hasta pronto.
Ivan

Francisco GMAIL wrote:

Por que no mejor mandas el archivo de muestra y podramos hacer alguna
pruebas con el mismo.

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