UniversoExcelForo

Respuesta a consultas.
Fecha de creación: 09.Abril.2012

Fundadores: Wibly,Tyno,Servando,Sakkar,Rosendo2,RMaximo,Railar,Mcoronel,Ioyama,Igtelo,Hugotron,Drochar,Dedos,Alberto,Adolfo

No se pueden hacer consultas de Excel o VBA por mensaje privado.
Utiliza el botón buscar del foro y te ahorras tiempo para obtener "ayuda".

No estás conectado. Conéctate o registrate

Ver el tema anterior Ver el tema siguiente Ir abajo  Mensaje [Página 1 de 1.]

Lehoi


Buenos días

Un día de estos me van a echar del foro por pesado, pero créanme que hago todo lo posible por encontrar las soluciones pero a veces  me trabo más que un arado jajaja

Bueno, tengo una tabla con datos extraídos de estadísticas de fútbol (ya saben que lo mío es el fútbol) Wink.
El problema es que he logrado extraer y copiar a su columna correspondiente algunos resultados (FT (Full Time, HT (Half Time), AET (After Extended Time) y AP (After Penalties)) pero no consigo encontrar la forma de extraer los resultados en los que este haya sido aumentado, es decir, que se haya producido un gol y descartar el resto.

En la tabla que adjunto se ve claramente en la hoja "Results (Wanted)" lo que quiero lograr, es mejor verlo que explicarlo lo aseguro Wink.
En la hoja "Results (Test)" se puede ejecutar la macro hasta donde he logrado que funcione.
Este es el código que tengo hecho hasta ahora (sé que es largo y lento, si algún experto quiere optimizarlo sería perfecto!)

Código:
Sub Clear()
Sheets("Results (Test)").Range("D2:D1048576").ClearContents
Sheets("Results (Test)").Range("F2:H1048576").ClearContents
Sheets("Results (Test)").Range("K2:BR1048576").ClearContents
End Sub

Sub XFerData_03()
'Test in Sheets "Results (Test)"
    Call Clear
    Dim RowGCnt As Long, CShtRow As Long
    Dim lastrow As Long
    Dim CellG As Range
    Dim ColumnCnt As Integer
    Dim intColLoop As Integer
    Dim LastColumn As Integer
    
    RowGCnt = 2
    FT = "FT"
    HT = "HT"
    AET = "AET"
    AP = "AP"
    
    LastColumn = Sheets("Results (Test)").Cells(1, Columns.Count).End(xlToLeft).Column
    lastrow = Sheets("Results (Test)").Range("A" & Rows.Count).End(xlUp).Row
FT:
    With Sheets("Results (Test)").Range("BW2:FH65536")
        'in case the specific is not on the range, check next
        If .Find(FT) Is Nothing Then GoTo HT
        For intColLoop = 75 To LastColumn '75 = Column "BW"
            For RowGCnt = 2 To lastrow
                With Columns(intColLoop)
                    'check if the result is in this column
                    If Not .Find(FT) Is Nothing Then
                        'find the desired Text
                        Set rngFound = .Find(FT)
                            'copy the found cell to the destination column
                        If Cells(RowGCnt, intColLoop).Value = FT Then
                            'Put the found data in the same row of origin:
                            Sheets("Results (Test)").Range("D" & RowGCnt).Value = Sheets("Results (Test)").Cells(RowGCnt, intColLoop).Offset(0, 2).Value
                        End If
                    End If
                End With
            Next RowGCnt
        Next intColLoop 'proceed to next column
    End With
HT:
    With Sheets("Results (Test)").Range("BW2:FH65536")
        'in case the specific is not on the range, check next
        If .Find(HT) Is Nothing Then GoTo AET
        For intColLoop = 75 To LastColumn   '75 = Column "BW"
            For RowGCnt = 2 To lastrow
                With Columns(intColLoop)
                    'check if the result is in this column
                    If Not .Find(HT) Is Nothing Then
                        'find the desired Text
                        Set rngFound = .Find(HT)
                            'copy the found cell to the destination column
                        If Cells(RowGCnt, intColLoop).Value = HT Then
                            'Put the found data in the same row of origin:
                            Sheets("Results (Test)").Range("F" & RowGCnt).Value = Sheets("Results (Test)").Cells(RowGCnt, intColLoop).Offset(0, 2).Value
                        End If
                    End If
                End With
            Next RowGCnt
        Next intColLoop 'proceed to next column
    End With
AET:
    With Sheets("Results (Test)").Range("BW2:FH65536")
        'in case the specific is not on the range, check next
        If .Find(AET) Is Nothing Then GoTo AP
        For intColLoop = 75 To LastColumn   '75 = Column "BW"
            For RowGCnt = 2 To lastrow
                With Columns(intColLoop)
                    'check if the desired text is in this column
                    If Not .Find(AET) Is Nothing Then
                        'find the desired text
                        Set rngFound = .Find(AET)
                            'copy the found cell to the destination column
                        If Cells(RowGCnt, intColLoop).Value = AET Then
                            'Put the found data in the same row of origin:
                            Sheets("Results (Test)").Range("G" & RowGCnt).Value = Sheets("Results (Test)").Cells(RowGCnt, intColLoop).Offset(0, 2).Value
                        End If
                    End If
                End With
            Next RowGCnt
        Next intColLoop 'proceed to next column
    End With
AP:
    With Sheets("Results (Test)").Range("BW2:FH65536")
        'in case the specific is not on the range, finish!
        If .Find(AP) Is Nothing Then GoTo Finish
        For intColLoop = 75 To LastColumn   '75 = Column "BW"
            For RowGCnt = 2 To lastrow
                With Columns(intColLoop)
                    'check if the result is in this column
                    If Not .Find(AP) Is Nothing Then
                        'find the desired text
                        Set rngFound = .Find(AP)
                            'copy the found cell to the destination column
                        If Cells(RowGCnt, intColLoop).Value = AP Then
                            'Put the found data in the same row of origin:
                            Sheets("Results (Test)").Range("H" & RowGCnt).Value = Sheets("Results (Test)").Cells(RowGCnt, intColLoop).Offset(0, 2).Value
                        End If
                    End If
                End With
            Next RowGCnt
        Next intColLoop 'proceed to next column
    End With
Finish:
End Sub

Gracias y un saludo
Lehoi
Archivos
Extracting Results and Goal Timing_v2.xlsb
No tienes los permisos para descargar los archivos.
(43 KB)

Igtelo


Hola Lehoi.

No entiendo tu pregunta, sin tanto rollo, pon un ejemplo manual; tengo esto y quiero esto.

Por otro lado corre tu macro por pasos, estás declarando variables y no las usas, haces buscar a Excel en rangos demasiado grandes.. Ve depurando.

Saludos
Ignacio Téllez

Lehoi


Que tal Igtelo, perdona la cháchara, el palique, la muela jejejeje

Bueno, he hecho lo que me sugeriste y he limpiado algo el código.
Verás por ejemplo que he logrado extraer los resultados 0 - 1 y 1 - 0 descartando los duplicados tras haberlos copiado a su celdas correspondientes.
El problema es que si tengo que hacer lo mismo (declarar variables, el bloque que hace la búsqueda, etc.) por cada resultado, me va a salir una macro de 500 lineas jajaja. 
 
Este es el código modificado (verás unos If muy largos pero los uso para que una vez haya extraído los resultados FT, HT, AET, AP no me los vuelva a extraer cuando estoy extrayendo los resultados con sus respectivos tiempos:
Código:
Sub Clear()
Sheets("Results (Test)").Range("D2:D1048576").ClearContents
Sheets("Results (Test)").Range("F2:H1048576").ClearContents
Sheets("Results (Test)").Range("K2:BR1048576").ClearContents
End Sub

Sub XFerData_03()
'OK, , Probando a extraer los resultados resultados FT, HT, AET, AP, "1 - 0" y "0 - 1"
'Test in Sheets "Results (Test)"
Call Clear
Dim RowGCnt As Long
Dim lastrow As Long
Dim intColLoop As Integer
Dim LastColumn As Integer
Dim LColARange As String

RowGCnt = 2
FT = "FT"
HT = "HT"
AET = "AET"
AP = "AP"
cerocero = "0 - 0"
unocero = "1 - 0"
cerouno = "0 - 1"

LastColumn = Sheets("Results (Test)").Cells(1, Columns.Count).End(xlToLeft).Column
lastrow = Sheets("Results (Test)").Range("A" & Rows.Count).End(xlUp).Row

With Sheets("Results (Test)").Range("BW2:FH65536")
    For intColLoop = 75 To LastColumn '75 = Column "BW"
        For RowGCnt = 2 To lastrow
            With Columns(intColLoop)
            
                'check if the result is in this column
                If Not .Find(FT) Is Nothing Then
                    'find the desired Text
                    Set rngFound = .Find(FT)
                        'copy the found cell to the destination column
                    If Cells(RowGCnt, intColLoop).Value = FT Then
                        'Put the found data in the same row of origin:
                        Sheets("Results (Test)").Range("D" & RowGCnt).Value = Sheets("Results (Test)").Cells(RowGCnt, intColLoop).Offset(0, 2).Value
                    End If
                End If
                
                If Not .Find(HT) Is Nothing Then
                    'find the desired Text
                    Set rngFound = .Find(HT)
                        'copy the found cell to the destination column
                    If Cells(RowGCnt, intColLoop).Value = HT Then
                        'Put the found data in the same row of origin:
                        Sheets("Results (Test)").Range("F" & RowGCnt).Value = Sheets("Results (Test)").Cells(RowGCnt, intColLoop).Offset(0, 2).Value
                    End If
                End If
            
                'check if the desired text is in this column
                If Not .Find(AET) Is Nothing Then
                    'find the desired text
                    Set rngFound = .Find(AET)
                        'copy the found cell to the destination column
                    If Cells(RowGCnt, intColLoop).Value = AET Then
                        'Put the found data in the same row of origin:
                        Sheets("Results (Test)").Range("G" & RowGCnt).Value = Sheets("Results (Test)").Cells(RowGCnt, intColLoop).Offset(0, 2).Value
                    End If
                End If
            
                'check if the result is in this column
                If Not .Find(AP) Is Nothing Then
                    'find the desired text
                    Set rngFound = .Find(AP)
                        'copy the found cell to the destination column
                    If Cells(RowGCnt, intColLoop).Value = AP Then
                        'Put the found data in the same row of origin:
                        Sheets("Results (Test)").Range("H" & RowGCnt).Value = Sheets("Results (Test)").Cells(RowGCnt, intColLoop).Offset(0, 2).Value
                    End If
                End If
            
                'check if the result is in this column
                If Not .Find(unocero) Is Nothing Then
                    'find the desired Text
                    Set rngFound = .Find(unocero)
                        'copy the found cell to the destination column
                    If Cells(RowGCnt, intColLoop).Value = unocero And Sheets("Results (Test)").Range("K" & RowGCnt).Value = "" _
                    And Cells(RowGCnt, intColLoop).Offset(0, -2).Value <> "HT" _
                    And Cells(RowGCnt, intColLoop).Offset(0, -2).Value <> "FT" _
                    And Cells(RowGCnt, intColLoop).Offset(0, -2).Value <> "AET" _
                    And Cells(RowGCnt, intColLoop).Offset(0, -2).Value <> "AP" Then
                        'Put the found data in the same row of origin:
                        Sheets("Results (Test)").Range("K" & RowGCnt).Value = Sheets("Results (Test)").Cells(RowGCnt, intColLoop).Offset(0, -2).Value
                        Sheets("Results (Test)").Range("L" & RowGCnt).Value = Sheets("Results (Test)").Cells(RowGCnt, intColLoop).Value
                    End If
                End If

                If Not .Find(cerouno) Is Nothing Then
                    'find the desired Text
                    Set rngFound = .Find(cerouno)
                        'copy the found cell to the destination column
                    If Cells(RowGCnt, intColLoop).Value = cerouno And Sheets("Results (Test)").Range("K" & RowGCnt).Value = "" _
                    And Cells(RowGCnt, intColLoop).Offset(0, -2).Value <> "HT" _
                    And Cells(RowGCnt, intColLoop).Offset(0, -2).Value <> "FT" _
                    And Cells(RowGCnt, intColLoop).Offset(0, -2).Value <> "AET" _
                    And Cells(RowGCnt, intColLoop).Offset(0, -2).Value <> "AP" Then
                        'Put the found data in the same row of origin:
                        Sheets("Results (Test)").Range("K" & RowGCnt).Value = Sheets("Results (Test)").Cells(RowGCnt, intColLoop).Offset(0, -2).Value
                        Sheets("Results (Test)").Range("L" & RowGCnt).Value = Sheets("Results (Test)").Cells(RowGCnt, intColLoop).Value
                    End If
                End If

            End With
        Next RowGCnt
    Next intColLoop 'proceed to next column
    End With
    Set rngFound = Nothing
End Sub
Archivos
Extracting Results and Goal Timing_v3.xlsb
No tienes los permisos para descargar los archivos.
(45 KB)

Igtelo


Lehoi.

No entiendo que quieres hacer, mientras no me sea claro que quieres lograr no puedo hacer algo, olvídate por el momento del código, necesito entender que quieres lograr por eso te pedí un ejemplo manual. (En una hoja tengo esto y en otra quiero esto, ahí explica de donde y como debe obtener el dato)

No me es claro:
El problema es que he logrado extraer y copiar a su columna correspondiente algunos resultados (FT (Full Time, HT (Half Time), AET (After Extended Time) y AP (After Penalties)) pero no consigo encontrar la forma de extraer los resultados en los que este haya sido aumentado, es decir, que se haya producido un gol y descartar el resto.

¿Cuales resultados, se haya aumentado donde, descartar que celdas, etc? 

Lehoi no es necesario escribir tanto, se hace uno más bolas, con un ejemplo detallado brevemente se podrá entender..

Saludos
Ignacio Téllez

Lehoi


OK Igtelo, trataré de explicarme mejor Wink :

-Los datos los extraigo con una macro de una página web y los coloca a partir de la columna BS (C71).

-Los datos que me interesan copiar los coloco en las columnas D, F, G, H y de la K a la BR. 

-Estos datos incluyen el resultado final (FT), el HT, el AP, el AET, y también incluye los goles con sus respectivos minutos de ejecución, tarjetas amarillas y rojas (con sus respectivos minutos de ejecución y el resultado actual en el momento de la tarjeta).

-El problema es que en los datos extraídos a mi no me interesan los resultados asociados a tarjetas, sino solo a los de goles marcados, o sea busco aquellos resultados que han cambiado respecto a sus predecesores en esa fila. Lógicamente sería coger el primer resultado cambiado.

En la hoja "Results (Wanted)" se ve lo que te quiero decir, por ejemplo:
En la fila 6 a partir de la columna 71:
   
C71C72C73C74C75C76C77C78C79C80C81C82C83C84C85C86C87C88C89C90C91C92C93C94C95
APReal Madrid1-1p.5-3Atlético Madrid11 0 - 0 15 1 - 0 HT 1 - 0 47 1 - 0 48 1 - 0 61
El 0 - 0 del minuto 11 no me interesa extraerlo porque ahí todavía no ha habido gol, el que me interesa extraer es el 1 - 0 del minuto 15.
El 1 - 0 después del HT ya lo he copiado antes y no me interesa volvera  tener en cuenta ese resultado 1 - 0 en particular, por eso en la macro en la condición If le digo que no lo extraiga si ya se ha hecho.

El objetivo es hacer estos pasos pero para todos los resultados a medida que vayan cambiando (porque ha habido goles), en este ejemplo en el minuto 79 viene el 1 - 1 ese sería el siguiente que quiero extraer
Esta es mas o menos la idea, y sé que es dífícil de explicar y de hacer.
Un abrazo

Igtelo


Lehoi:

A ver, creo que ya estoy entendiendo, creo... Pero primero vas a hacer una tabla entendible para todo mundo no nada más para ti.

Pon títulos a todas y cada una de tus columnas porque solamente tú sabes de que hablas, vas a quitar lo de C71, C75, etc y pon títulos.
Si te complicas porque son muchas columnas, te dejo 2 macros que vas a agregar a personales y 2 botones en cinta de opciones. ¿Sale? Con éstas podrás tener la referencia de la columna tanto en letras como número, así ocupas correctamente las celdas y no con el C79, C90 y ya con títulos podré empezar a ver de que se trata.

Esto es muy necesario porque piensas que uno conoce el tema, pero no, para que sea "universal" (válgame la expresión) debes preguntar con datos de celdas, rangos, condiciones y no de futbol.

Sub Titnumeros()
'Columna en número
Application.ReferenceStyle = xlR1C1
End Sub


Sub Titletras()
'Columna en Letras
Application.ReferenceStyle = xlA1
End Sub

Te repito, como no me es claro yo no puedo hacer algo, ya si alguien más le entra y entiende ten por seguro que te lo hará.

Saludos
Ignacio Téllez

Lehoi


Hola Igtelo, aquí son las 7 AM y na mas levantarme ya estoy "fajao" con el excel  cyclops

Bueno, las macros que me pasaste son joyitas, sobre todo la de convertir a números, no sabía que se podía hacer eso jeje. Yo tengo una hoja impresa donde tengo miles de columnas y sus números, pero esto es más profesional Wink

Lo de las cabeceras C71, C72 etc era porque en realidad el nombre en esas columnas no me importaba mucho, la C es de "Columna" y su número claro. Como el ancho de la columna es poco, no lo escribí todo.
Pero tienes razón que es muy poco intuitivo.

De hecho, ni siquiera tenía intención de ponerle título a las cabeceras de esas columnas, tuve que hacerlo porque la línea de la macro que me detecta la última columna usada, no me las reconocía por no tener cabeceras.

Por cierto, estoy viendo un video en youtube de 1 hora! sobre arrays, cada vez me convenzo más de que estoy en pañales jeje

Un abrazo y gracias por intentar ayudarme a pesar de la "guerra" que te estoy dando con la dichosa tabla Rolling Eyes Laughing

Edito: He subido la tabla con unas cabeceras más lógicas y entendibles (creo jeje) en la hoja Results (Test).
Verás que a partir de la celda B24 he puesto un listado de todos los posibles resultados siempre que un equipo no haga más de 30 goles (que ha pasado jaja), verás que son muchísimos, por eso no le veo sentido a hacer una búsqueda usando esa lista, sino analizando el contenido de la celda y comparándolo con la anterior.
Creo que los tiros van por extraer los números de la cadena de texto y compararlos, en fin... confused
Archivos
Extracting Results and Goal Timing_v3.xlsb
No tienes los permisos para descargar los archivos.
(56 KB)

Lehoi


Muy buenas

Bueno he logrado hacer que funcione aunque me gustaría que fuese más rápido, para analizar 90 columnas y 6 filas me tarda unos 0,35 segundos, pero si hablamos de mil filas ya la cosa cambia bastante.....
Si alguien sabe como optimizarlo se lo agradecería muchísimo.

Al final he conseguido detectar todos los resultados aparte del 0 - 0, el 1 - 0 y el  0 - 1 con una expresión regular, es una maravilla usar expresiones regulares para encontrar patrones.

Este es el código, lo más probable es que no le sirva de mucho a quien lo vea ya que es para un proyecto muy específico, pero nadie sabe.

Código:
Sub Clear()
Sheets("Results (Test)").Range("D2:D1048576").ClearContents
Sheets("Results (Test)").Range("F2:H1048576").ClearContents
Sheets("Results (Test)").Range("K2:BR1048576").ClearContents
End Sub

Sub XFerData_03()
'Test in Sheets "Results (Test)"
Dim StartTime As Double
StartTime = Timer
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Call Clear
Dim RowGCnt As Long
Dim lastrow As Long
Dim intColLoop As Integer
Dim LastColumn As Integer
Dim LColARange As String
Dim unocero As String
Dim cerouno As String
Dim OtherResult As String
Dim LastResult As String
Dim regex As Object, str As String
Set regex = CreateObject("VBScript.RegExp")

With regex
    'Reconoce los resultados con el formato "0 - 0", "1 - 12", "12 - 1" "12 - 11"
    '(número con 1 o 2 cifras,espacio,guion,espacio,número con 1 o 2 cifras)
    .Pattern = "^[0-9]\d{0,1}\s[-]\s[0-9]\d{0,1}$"
End With

RowGCnt = 2
FT = "FT"
HT = "HT"
AET = "AET"
AP = "AP"
unocero = "1 - 0"
cerouno = "0 - 1"

LastColumn = Sheets("Results (Test)").Cells(1, Columns.Count).End(xlToLeft).Column
lastrow = Sheets("Results (Test)").Range("A" & Rows.Count).End(xlUp).Row

With Sheets("Results (Test)").Range("BW2:FH65536")
    For RowGCnt = 2 To lastrow
        For intColLoop = 75 To LastColumn '75 = Column "BW"
            With Rows(RowGCnt)
                'check if the result is in this cell
                If Not .Find(FT) Is Nothing _
                Or .Find(HT) Is Nothing _
                Or .Find(AET) Is Nothing _
                Or .Find(AET) Is Nothing _
                Or .Find(unocero) Is Nothing _
                Or .Find(cerouno) Is Nothing Then
                    'find the desired Text
                        'copy the found cell to the destination column
                    If Cells(RowGCnt, intColLoop).Value = FT Then
                        'Put the found data in the same row of origin:
                        Sheets("Results (Test)").Range("D" & RowGCnt).Value = Sheets("Results (Test)").Cells(RowGCnt, intColLoop).Offset(0, 2).Value
                    End If
                    If Cells(RowGCnt, intColLoop).Value = HT Then
                        'Put the found data in the same row of origin:
                        Sheets("Results (Test)").Range("F" & RowGCnt).Value = Sheets("Results (Test)").Cells(RowGCnt, intColLoop).Offset(0, 2).Value
                    End If
                    If Cells(RowGCnt, intColLoop).Value = AET Then
                        'Put the found data in the same row of origin:
                        Sheets("Results (Test)").Range("G" & RowGCnt).Value = Sheets("Results (Test)").Cells(RowGCnt, intColLoop).Offset(0, 2).Value
                    End If
                    If Cells(RowGCnt, intColLoop).Value = AP Then
                        'Put the found data in the same row of origin:
                        Sheets("Results (Test)").Range("H" & RowGCnt).Value = Sheets("Results (Test)").Cells(RowGCnt, intColLoop).Offset(0, 2).Value
                    End If
                    If Cells(RowGCnt, intColLoop).Value = unocero And Sheets("Results (Test)").Range("K" & RowGCnt).Value = "" _
                    And Cells(RowGCnt, intColLoop).Offset(0, -2).Value <> "HT" _
                    And Cells(RowGCnt, intColLoop).Offset(0, -2).Value <> "FT" _
                    And Cells(RowGCnt, intColLoop).Offset(0, -2).Value <> "AET" _
                    And Cells(RowGCnt, intColLoop).Offset(0, -2).Value <> "AP" Then
                        'Put the found data in the same row of origin:
                        Sheets("Results (Test)").Range("K" & RowGCnt).Value = Sheets("Results (Test)").Cells(RowGCnt, intColLoop).Offset(0, -2).Value
                        Sheets("Results (Test)").Range("L" & RowGCnt).Value = Sheets("Results (Test)").Cells(RowGCnt, intColLoop).Value
                    End If
                    If Cells(RowGCnt, intColLoop).Value = cerouno And Sheets("Results (Test)").Range("K" & RowGCnt).Value = "" _
                    And Cells(RowGCnt, intColLoop).Offset(0, -2).Value <> "HT" _
                    And Cells(RowGCnt, intColLoop).Offset(0, -2).Value <> "FT" _
                    And Cells(RowGCnt, intColLoop).Offset(0, -2).Value <> "AET" _
                    And Cells(RowGCnt, intColLoop).Offset(0, -2).Value <> "AP" Then
                        'Put the found data in the same row of origin:
                        Sheets("Results (Test)").Range("K" & RowGCnt).Value = Sheets("Results (Test)").Cells(RowGCnt, intColLoop).Offset(0, -2).Value
                        Sheets("Results (Test)").Range("L" & RowGCnt).Value = Sheets("Results (Test)").Cells(RowGCnt, intColLoop).Value
                    End If
                End If
                If Cells(RowGCnt, intColLoop).Value <> "" _
                    And Cells(RowGCnt, intColLoop).Value <> "FT" _
                    And Cells(RowGCnt, intColLoop).Value <> "HT" _
                    And Cells(RowGCnt, intColLoop).Value <> "AET" _
                    And Cells(RowGCnt, intColLoop).Value <> "AP" _
                    And Cells(RowGCnt, intColLoop).Value <> "0 - 0" _
                    And Cells(RowGCnt, intColLoop).Value <> "0 - 1" _
                    And Cells(RowGCnt, intColLoop).Value <> "1 - 0" _
                    And Cells(RowGCnt, intColLoop).Offset(0, -2).Value <> "HT" _
                    And Cells(RowGCnt, intColLoop).Offset(0, -2).Value <> "FT" _
                    And Cells(RowGCnt, intColLoop).Offset(0, -2).Value <> "AET" _
                    And Cells(RowGCnt, intColLoop).Offset(0, -2).Value <> "AP" Then
                    OtherResult = Cells(RowGCnt, intColLoop).Value

                    'If OtherResult <> ActiveCell.Offset(0, 1).Value Then
                    If OtherResult <> LastResult Then 'Compare to variable
                        'If regex.Test(Cells(RowGCnt, intColLoop).Value) Then
                        If regex.Test(OtherResult) Then 'Testing variable
                            'Put the found data in the same row of origin:
                            Range("K" & RowGCnt).Select
                            Selection.End(xlToRight).Offset(0, 1).Select
                            ActiveCell = Sheets("Results (Test)").Cells(RowGCnt, intColLoop).Offset(0, -2).Value
                            ActiveCell.Offset(0, 1) = Sheets("Results (Test)").Cells(RowGCnt, intColLoop).Value
                            LastResult = ActiveCell.Offset(0, 1).Value
                        End If
                    End If
                End If
            End With
        Next intColLoop 'proceed to next column
    Next RowGCnt
End With
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Beep
MsgBox Format(Timer - StartTime, "00.00") & " segundos"
End Sub

Saludos

Igtelo


Hola Lehoi.

Sigo sin entender tu tabla, viendo trabajar tu macro la única referencia que me es útil son los colores, creo que esto te servirá, corre más rápido y código sencillo.

Saludos
Ignacio Téllez
Archivos
Lehoi-Extraer datos.xlsm
No tienes los permisos para descargar los archivos.
(103 KB)

Lehoi


Hola Igtelo

Ante todo muchas gracias por el tiempo y el esfuerzo, lo que has hecho me vale incluso aunque no era exactamente la idea inicial, porque el objetivo no era reconocer los resultados por colores sino por que sea mayor que el resultado anterior en esa misma fila, es decir, que se haya marcado un gol.
Lo que quizás indujo a que entendieras eso es que no aclaré que los colores eran para resaltar los resultados que quería copiar. Pero dicen que lo que sucede conviene y este código lo voy a usar en esta misma tabla para otra cosa jejeje Wink (autofiltrado por colores y luego copiar según sea el caso)

Si puedes probar el último código que he subido y echarle un vistazo a ver como se puede mejorar sería la repera como se dice aquí  Laughing. Si lo pruebas ya que has añadido las dos columnas "En minuto" y "Después gol" para que te coincida la macro mía con esta tabla sería eliminar las dos columnas "Reserved". 

De nuevo, gracias por todos los trozos de conocimientos que nos das y los apuros de los que nos sacas.

Un fuerte abrazo!

Lehoi

Igtelo


Hola Lehoi.

Eureka!! decidí abrir el tema porque acabo de hacerle algo a un amigo con un simple Like y eso se aplica a tu archivo a excepción del medio tiempo, como siempre, códigos cortos... Para ejecutar CTRL+k

Saludos
Ignacio Téllez
Archivos
Igtelo-Lehoi-Extraer datos2.xlsm
No tienes los permisos para descargar los archivos.
(35 KB)

Lehoi


Hola Igtelo y compañía claro Wink

He probado el código que hiciste usando el "Like" y de verdad que es rápido, no conocía esa función (ya van dos que he aprendido a usar en este hilo: el Find y el Like!

Lo que me comentas del mediotiempo no lo entiendo, en los datos originales todos las filas menos la del partdo anulado (el que tiene el ANL) tienen el HT. De todas maneras he añadido a tu código la opción del HalfTime y va de lujo.

Saludos y de nuevo aunque me repita más que el ajo..... gracias!  Very Happy

Igtelo


Que tal Lehoi.

Ok, ya ví el original, efectivamente ahí si está indicado...
Ya nada más como colofón, jeje. No es necesario el Like ni los 2 bucles, con find es más rápido, sólo usas un bucle, bueno ahí le buscas. Ya lo damos por terminado.

Saludos
Ignacio Téllez

Ver el tema anterior Ver el tema siguiente Volver arriba  Mensaje [Página 1 de 1.]

Permisos de este foro:
No puedes responder a temas en este foro.