raocarlos600
4/11/2018 - 6:51 AM

AlgoritmoRecorridoVBA

Algoritmo de recorrido de las filas de un Excel. Ordena el Excel y recorre las filas con un valor inicial y un valor actual que es el que va leyendo de cada fila. Cuando hay un corte de valores (que cambia y no son el mismo), recorre esa franja para darle un valor concreto a esas lineas que tienen un mismo valor.

AlgoritmoRecorridoOrdenado
content_copyfile_download
Dim contratoInicial As String
    Dim contratoActual As String
    Dim auxClave As String
    Dim auxSegmentos As String
    Dim NumRows As Long
    Dim contador As Long
    
    NumRows = Range("B2", Range("B2").End(xlDown)).Rows.Count
    
    Range("A1", Range("L1").End(xlDown)).Select
    Selection.Sort Key1:=Range("J1"), Order1:=xlAscending, Key2:=Range("L1"), Order2:=xlAscending, Key3:=Range("E1"), Order3:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    
    For x = 2 To NumRows + 1
        contratoInicial = Cells(x, "L")
        contador = 0
        auxClave = ""
        auxSegmentos = ""
        For j = x To NumRows + 1
             contratoActual = Cells(j, "L")
             If contratoInicial = contratoActual Then
                 contador = contador + 1
                 auxClave = auxClave & Cells(j, "E")
                 auxSegmentos = auxSegmentos & Cells(j, "D")
             ElseIf contratoInicial <> contratoActual Then
                 For k = x To x + contador - 1
                    Cells(k, "M") = "'" & auxClave
                    Cells(k, "N") = "'" & auxSegmentos
                Next
                x = x + contador - 1
                Exit For
             End If
             If j = NumRows + 1 Then
                For k = x To x + contador - 1
                    Cells(k, "M") = "'" & auxClave
                    Cells(k, "N") = "'" & auxSegmentos
                Next
                x = x + contador - 1
                Exit For
             End If
         Next
               
    Next