Buenas, estoy con un problema ya que debo buscar 5 variables tomadas
de una hoja (que están en una misma línea) y buscarlas en otra hoja
(principal) donde esten en una misma línea. Si las encuentra, copia
otros 2 valores y los agrega en la columna correspondiente. Si no las
encuentra, agrega estas 5 mas los otros dos valores en una nueva
línea.
Esto lo hace desde varías hojas de donde obtiene el valor de las
variables, y copia todo en la hoja principal donde junto los datos de
todas las hojas, lo que hace que llegue un momento que son muchas
líneas donde tiene que comparar.
Existe una forma mas facil de realizar esta comparación no sea linea x
linea, sino algo parecido a un "Find"?
Puede ser un tema de memoria?
Dejo la parte del código que trae problemas.
'--Create the annual consolidation--
Sheets.Add Before:=Sheets(1)
ActiveSheet.Name = "Consolidated"
ActiveSheet.Tab.ColorIndex = 11
Set WSD2 = Worksheets(ActiveSheet.Name)
Dim ws As Worksheet
lCol = 7
For Each ws In ActiveWorkbook.Worksheets
'Check if the sheetŽs name contains Table
ShName = ws.Name
sText = "Table"
lText = Right$(ShName, 5)
If lText = sText Then
a = 2
Do
StartRow = WSD2.Cells(Application.Rows.Count, 2).End
(xlUp).Row
Program = ws.Cells(a, 2)
Platform = ws.Cells(a, 4)
Devices = ws.Cells(a, 5)
Operator = ws.Cells(a, 6)
Title = ws.Cells(a, 3)
Total = Format(ws.Cells(a, 7), "###0.00")
TimeS = Format(ws.Cells(a, 8).Value, "Percent")
'Find if already exists in sheet
b = 2
Do
If WSD2.Cells(b, 2) = Program And _
WSD2.Cells(b, 3) = Title And _
WSD2.Cells(b, 4) = Platform And _
WSD2.Cells(b, 5) = Devices And _
WSD2.Cells(b, 6) = Operator Then
WSD.Cells(b, lCol) = CDec(Total)
WSD.Cells(b, lCol + 1) = Format(TimeS,
"Percent")
WSD.Cells(b, 8).TextToColumns
Destination:=WSD2.Cells(b, lCol + 1), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote,
ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False,
Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
b = 2
Found = "Yes"
Exit Do
Else
b = b + 1
If Cells(b, 2) = "" Then
Found = "No"
Exit Do
End If
End If
Loop
If Found = "No" Then
StartRow = StartRow + 1
WSD2.Cells(StartRow, 1) = "Mobile"
WSD2.Cells(StartRow, 2) = Program
WSD2.Cells(StartRow, 3) = Title
WSD2.Cells(StartRow, 4) = Platform
WSD2.Cells(StartRow, 5) = Devices
WSD2.Cells(StartRow, 6) = Operator
WSD2.Cells(StartRow, lCol) = CDec(Total)
WSD2.Cells(StartRow, lCol + 1) = TimeS
WSD2.Cells(StartRow, lCol + 1).TextToColumns
Destination:=WSD2.Cells(StartRow, lCol + 1), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote,
ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False,
Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
b = 2
End If
a = a + 1
If ws.Cells(a, 1) = "" And ws.Cells(a, 2) = "" And
ws.Cells(a, 3) = "" And ws.Cells(a, 4) = "" And ws.Cells(a, 5) = ""
And ws.Cells(a, 6) = "" Then Exit Do
Loop
'-get the name for column headers
ShName = ws.Name
sText = "Table"
lText = Left(ShName, 6)
Cells(1, lCol) = lText
Cells(1, lCol + 1) = "%Time Spent for " & lText
lCol = lCol + 2
End If
Next
Muchisimas gracias!!
Leer las respuestas