Necesito una macro o alguna fórmula que me ayude a encontrar datos en una lista enorme.
Lo que necesito es que esta macro corra de manera que busque de entre la cantidad de registros de una sola variable lo siguiente:
Numero de cliente salida entrada primer cliente ultimo cliente efectividad
1 6:00 18:00 7:00 15:20 70%
Del registro 1 o numero de cliente hay 100 filas de información. Para el cliente 2 solo hay 90 y así fluctúan, no hay manera de saber cuantos registros generará el cliente 1 o el cliente 2. Y lo que quiero que haga la macro es que tome la primera hora ( que es salida) y la ultima hora del cliente 1 ( que es entrada) que me diga cual es la hora en que llegó con el primer cliente y a que hora llegó con el ultimo cliente y así otros datos.
¿De qué manera puedo hacer esto?
1 Respuesta
perdón por no haberlo mandado antes, pero no tenía todos los registros,
ya te mandé el archivo muchas gracias nuevamente por toda tu ayuda.
H o l a
Te anexo la macro
Sub Extraer()
'Por.Dante Amor
u = Range("B" & Rows.Count).End(xlUp).Row
Range("C3:F" & u).ClearContents
For i = 3 To u
For j = 2 To Range("j" & Rows.Count).End(xlUp).Row
c = InStr(1, UCase(Cells(i, "B")), Cells(j, "J"))
If c > 0 Then
cad = ""
For k = 1 To c
If (IsNumeric(Mid(Cells(i, "B"), k, 1)) And _
Mid(Cells(i, "B"), k, 1) <> "") Or _
Mid(Cells(i, "B"), k, 1) = "." Then
cad = cad & Mid(Cells(i, "B"), k, 1)
End If
Next
Select Case j
Case 2, 3: col = 3
Case 4, 5: col = 4
Case 6, 7: col = 5
End Select
Cells(i, col) = cad
Exit For
End If
Next
c1 = InStrRev(Cells(i, "B"), " ")
c2 = Mid(Cells(i, "B"), c1)
c3 = Replace(c2, "B", "")
Cells(i, "F") = c3
Next
End Subsal u dos
H o l a:
Te anexo la macro correspondiente a esta pregunta:
Sub ResumenRuta()
'Por.Dante Amor
Set h1 = Sheets("Hoja1")
Set h2 = Sheets("datos")
Set h3 = Sheets("unicos")
h3.Columns("A:Z").ClearContents
h3.[A1] = h2.[C3]
h3.[A2] = ""
u = h2.Range("C" & Rows.Count).End(xlUp).Row
h2.Range("C3:C" & u & ",K3:K" & u).Copy h3.[C3]
h3.Range("C3:D" & u).AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=h3.Range("A1:A2"), CopyToRange:=h3.Range("G3"), Unique:=True
u2 = h3.Range("G" & Rows.Count).End(xlUp).Row
h3.Range("G3:G" & u2).AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=h3.Range("A1:A2"), CopyToRange:=h3.Range("K3"), Unique:=True
'
u3 = h3.Range("K" & Rows.Count).End(xlUp).Row
With h3.Range("L4:L" & u3)
.FormulaR1C1 = "=COUNTIF(RC[-5]:R[13]C[-5],RC[-1])"
.Value = .Value
End With
'
h1.Range("B3:M" & Rows.Count).ClearContents
j = 3
For i = 4 To u3
sig = h3.Cells(i, "K")
Set b = h2.Columns("C").Find(h3.Cells(i, "K"), lookat:=xlWhole)
If Not b Is Nothing Then
ini = h2.Cells(b.Row, "F")
End If
Set b = h2.Columns("C").Find(h3.Cells(i, "K"), lookat:=xlWhole, searchdirection:=xlPrevious)
If Not b Is Nothing Then
fin = h2.Cells(b.Row, "F")
End If
h1.Cells(j, "C") = h3.Cells(i, "K")
h1.Cells(j, "D") = ini
h1.Cells(j, "E") = fin
h1.Cells(j, "H") = h3.Cells(i, "L")
j = j + 1
Next
MsgBox "Fin"
End Subsal u dos
