Buscar 5 variable que esten en una misma linea

30/12/2009 - 16:05 por juanma.marti | Informe spam
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

#1 Héctor Miguel
31/12/2009 - 08:10 | Informe spam
hola, juan !

tratando de adivinar el tipo de datos de tu situacion real y sin conocer el "por-que" del uso de .TextToColumns (???)
el siguiente ejemplo (parece que) "funciona" identificando si el dato ya existe o se debe agegar en la "siguiente fila libre"
(tambien... "solo la parte con el problema")

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

Sub ConsolidaTablas()
Application.ScreenUpdating = False
Dim Hoja As Worksheet, nHoja As Byte, nCol As Byte, hNombre As String
Dim Fila As Integer, xFila As Integer, nFila As Integer
Worksheets.Add Before:=Worksheets(1)
ActiveSheet.Name = "Consolidated"
[a1:f1] = Array("Mobile", "Program", "Title", "Platform", "Device", "Operator")
ActiveSheet.Tab.ColorIndex = 11
For Each Hoja In Worksheets
With Hoja
If Right(LCase(.Name), 5) <> "table" Then GoTo Siguiente
nHoja = nHoja + 1
nCol = 5 + (nHoja * 2)
hNombre = "'" & .Name & "'!"
For Fila = 2 To .[b65536].End(xlUp).Row
xFila = [a65536].End(xlUp).Row
nFila = 0
On Error Resume Next
nFila = Evaluate("match(" & _
hNombre & "b" & Fila & "&" & hNombre & "c" & Fila & "&" & _
hNombre & "d" & Fila & "&" & hNombre & "e" & Fila & "&" & hNombre & "f" & Fila & _
",b1:b" & xFila & "&c1:c" & xFila & "&d1:d" & xFila & "&e1:e" & xFila & "&f1:f" & xFila & ",0)")
On Error GoTo 0
nFila = IIf(nFila, nFila, xFila + 1)
With .Range("b" & Fila)
If nFila = xFila + 1 Then
Range("a" & nFila).Value = .Offset(, -1).Value
Range("a1").Offset(, nCol - 1).Resize(, 2) = Array( _
Mid(hNombre, 2, 6), "%Time Spent for " & Mid(hNombre, 2, 6))
End If
Range("b" & nFila).Resize(, 5).Value = Array( _
.Value, .Offset(, 1).Value, .Offset(, 2).Value, .Offset(, 3).Value, .Offset(, 4).Value)
Range("a" & nFila).Offset(, nCol - 1).Resize(, 2).Value = Array( _
.Offset(, 5).Value, .Offset(, 6).Value)
End With
Next
End With
Siguiente:
Next
End Sub

__ OP __
... debo buscar 5 variables tomadas de una hoja (... en una misma linea) y buscarlas en otra hoja... en una misma linea.
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 linea.
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 lineas 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...

Preguntas similares