Problemas de impresión de datos en excel
Estimados, tengo un problema con la impresión de valores en una celda. El código que tengo es el siguiente que, aunque largo, el principio es mucha declaración de variables, lo adjunto a contnuación.
En la búsqueda no puedo usar la función vlookup ya que en ambas tablas tengo valores repetidos. Es decir, en un mes determinado el usuario "x" hace varias transacciones en fechas distintas ("Tabla1"), y en la tabla 2 tengo a que departamento pertenece ese usuario "x" y entre qué fechas perteneció a ese departamento.
Es decir:
Tabla1 Tabla2
Usuario .........Fecha Usuario.... Departamento.....Desde Hasta
x 1/01/2001 x Cobranzas 28/10/2000 3/01/2001
x 2/01/2001 x Operaciones 4/01/2001 +hoy()
y 2/01/2001 y Finanzas 2/07/1995 +hoy()
z 4/01/2001 etc
d 4/01/2001
x 5/01/2001
d 8/01/2001
Necesito que en la tabla1, para la primera transaccion de "X" me imprima que el departamento era cobranzas, que en la segunda imprima "cobranzas" y que en la tercera de "x" imprima "Operaciones"
Si alguien pudiera comentar porque no imprimer el valor sería de gran ayuda !
De antemano, gracias !
Sub Resumen_Planillas_Individuales_CE()
Dim i As Integer
Dim x As Integer
Dim celda As Object
Dim celda1 As Object
Dim y As Integer
Dim z As Integer
Dim rango As Range
Dim rango2 As Range
Dim rango3 As Range
Dim fecha1 As Date
Dim fecha2 As Date
Dim fecha_servicio As Date
Dim ruta As String
Dim fila As Integer
Dim auxiliar
Dim GC As String
Dim ceco As String
Dim patente As String
Dim hoja As Worksheet
Dim a1(0 To 1) As Variant
Dim a2(0 To 2) As Variant
nombre_archivo = ActiveWorkbook.Name
direccion_archivo = ActiveWorkbook.FullName
'MsgBox direccion_archivo
x = WorksheetFunction.CountA(Range("A:A"))
Range("G2:G" & x).NumberFormat = "dd/mm/yyyy"
Range("H2:H" & x).NumberFormat = "[$-F400]h:mm:ss AM/PM"
Set rango = Range("D2:D" & x)
Range("I:I").Select
Selection.Insert shift:=xlToRight, copyorigin:=xlformanfromleftorabove
Range("I1").Value = "Mes"
Range("I2:I" & x).NumberFormat = "General"
Range("E:E").Select
Selection.Insert shift:=xlToRight, copyorigin:=xlformanfromleftorabove
Range("E1").Value = "Patente1"
Range("E2:E" & x).NumberFormat = "General"
For Each celda In rango.Cells
Cells(celda.Row, "E") = Left(celda, 7)
Cells(celda.Row, "J") = Month(Cells(celda.Row, "H"))
Next
Range("F:F").Select
Selection.Insert shift:=xlToRight, copyorigin:=xlformanfromleftorabove
Range("F1").Value = "Centro de Costo"
Range("F:F").Select
Selection.Insert shift:=xlToRight, copyorigin:=xlformanfromleftorabove
Range("F1").Value = "Gerencia Corporativa"
Range("F:F").Select
Selection.Insert shift:=xlToRight, copyorigin:=xlformanfromleftorabove
Range("F1").Value = "Sociedad"
Range("K2:K" & x).NumberFormat = "dd/mm/yyyy"
Set rango = Range("E2:E" & x)
Workbooks.Open ("C:\Users\Usuario\Desktop\CONSUMOS\FLOTA RENTING - PROPIA OPERATIVA 04-02-2013.xlsx")
Workbooks("FLOTA RENTING - PROPIA OPERATIVA 04-02-2013.xlsx").Activate
Worksheets("Flota Renting").Select
y = WorksheetFunction.CountA(Range("A:A"))
Set rango2 = Workbooks("FLOTA RENTING - PROPIA OPERATIVA 04-02- 2013.xlsx").Worksheets("Flota Renting").Range("A2:W" & y)
Range("V2:W" & y).NumberFormat = "dd/mm/yyyy"
Set rango_patentes_renting = Range("A1:A" & y)
'Set hoja = Worksheets.Add
'hoja.Name = "Patentes Únicas Renting"
'Worksheets("Flota Renting").Select
'Range("A1:A" & y).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Worksheets("Patentes Únicas Renting").Range("B2"), Unique:=True
'Selection.Insert , shift:=xlToRight, copyorigin:=xlformanfromleftorabove
Workbooks(nombre_archivo).Activate
'Range("A:A").Select
'Selection.Insert , shift:=xlToRight, copyorigin:=xlfromleftorabove
On Error Resume Next
For Each celda In rango.Cells
fecha_servicio = Cells(celda.Row, "K")
If IsError(Application.VLookup(celda.Value, rango2, 5, False)) = False Then
a1(0) = Cells(celda.Value)
a1(1) = Cells(fecha_servicio)
Workbooks("FLOTA RENTING - PROPIA OPERATIVA 04-02-2013.xlsx").Worksheets("Flota Renting").Activate
For Each celda1 In rango_patentes_renting
If a1(0) = celda1 Then
fila = ActiveCell.Row
If a1(1) >= Cells(celda1.Row, "V") And a1(1) <= Cells(celda1.Row, "W") Then
GC = Cells(celda1.Row, "E")
ceco = Cells(celda1.Row, "T")
Workbooks(direccion_arhivo).Activate
Cells(celda.Row, "G") = GC
Cells(celda.Row, "H") = ceco
End If
End If
Next
....
End Sub
