Lista Desplegable VBA
Publicado por Gustavo (2 intervenciones) el 04/03/2014 22:38:57
Buenas tardes para todos:
Tengo un archivo en excel en el cual consta de dos partes
Hoja2= Lista donde deben ir los items los cuales incumplieron los escoltas
Nhojas= donde Cada hoja pertenece a un escolta el cual debe cumplir con los items (Credencial, libreta militar, arma 9ml, chaleco ETC...) el cual se le califica como 1=lo tiene 0= debe ir a la lista
Cada vez que el escolta incumpla con un item, debe ir registrado en la lista correspondiente de cada ítem, el problema es que ya he llevado un progreso para ello pero solo me funciona en el rango D16:D24 que me copia muy bien el nombre y la cedula del escolta pero cuando amplio el rango no hace lo mismo y los rango en los cuales se le califica con 1 y 0 son:
d14:d24, f17:f24, h14:h18, j13:j19, j22,:j24, l14:l18, n13:n19 y n22:n24
agradezco su atención prestada...
Pdta: Adjunto el workbook
Tengo un archivo en excel en el cual consta de dos partes
Hoja2= Lista donde deben ir los items los cuales incumplieron los escoltas
Nhojas= donde Cada hoja pertenece a un escolta el cual debe cumplir con los items (Credencial, libreta militar, arma 9ml, chaleco ETC...) el cual se le califica como 1=lo tiene 0= debe ir a la lista
Cada vez que el escolta incumpla con un item, debe ir registrado en la lista correspondiente de cada ítem, el problema es que ya he llevado un progreso para ello pero solo me funciona en el rango D16:D24 que me copia muy bien el nombre y la cedula del escolta pero cuando amplio el rango no hace lo mismo y los rango en los cuales se le califica con 1 y 0 son:
d14:d24, f17:f24, h14:h18, j13:j19, j22,:j24, l14:l18, n13:n19 y n22:n24
agradezco su atención prestada...
Pdta: Adjunto el workbook
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
On Error GoTo fin:If Target.Count > 1 Then Exit Sub
If Sh.Name = "Hoja2" Then Exit Sub
If Not Application.Intersect(Target, Range("d14:d24", "f17:f24")) Is Nothing Then
If Target.Value = 0 And Target.Value <> "" Then
nombrecol = Target.Column - 1
nombre = Cells(10, nombrecol).Value
cedula = Cells(13, nombrecol + 1)
num_item = Target.Offset(0, -1).Value
End If
With Sheets("Hoja2").Rows(2)
Set buscaitem = .Find(num_item, lookat:=xlWhole)
If buscaitem Is Nothing Then Exit Sub
colitem = buscaitem.Address
End With
linvacia = Sheets("Hoja2").Range(colitem).End(xlDown).Row + 1
Sheets("Hoja2").Cells(linvacia, buscaitem.Column) = nombre
Sheets("Hoja2").Cells(linvacia, buscaitem.Column + 1) = cedula
End If
fin:End Sub
- formato.rar(56,3 KB)
Valora esta pregunta
0