You are here:---Rispondi a: Ordinare Dati
Rispondi a: Ordinare Dati 2019-02-19T11:41:42+01:00

Home Forum Domande su Excel VBA e MACRO Ordinare Dati Rispondi a: Ordinare Dati

sidsid
Moderatore
    Post totali: 582

    Ciao

    Un esempio sicuramente migliorabile

    Sub ORDINA_DDT()
    Dim ws As Worksheet
    Dim nDDT As Integer
    Dim nRiga As Long, j As Long, k As Long
    Dim vTabella As Variant, vArr() As Variant
    Dim rng As Range
    
    Set ws = Sheets("fattura") 'nome tuo foglio
    nRiga = ws.Range("A" & Rows.Count).End(xlUp).Row
    Set rng = ws.Range("B1:B" & nRiga)
    vTabella = rng
    
    'conto i "DDT"
    nDDT = Application.WorksheetFunction.CountIf(rng, "DDT*")
    ReDim Preserve vArr(1 To nDDT, 1 To 2)
    
    'trovo il numero riga delle celle la cui stringa inizia per "DDT",
    'ed imposto i range di ogni DDT
    For j = LBound(vTabella) To UBound(vTabella)
        If vTabella(j, 1) Like "DDT*" Then
            k = k + 1
            If k = 1 Then
                vArr(k, 1) = j
            Else
                vArr(k, 1) = j
                vArr(k - 1, 2) = j - 1
            End If
            If k = nDDT Then
                vArr(k, 2) = nRiga
                Exit For
            End If
        End If
    Next j
    
    'ordinamento per DDT
    For j = LBound(vArr) To UBound(vArr)
        ws.Sort.SortFields.Clear
        ws.Sort.SortFields.Add Key:=ws.Range("A" & vArr(j, 1) + 1 & ":A" & vArr(j, 2)) _
            , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        With ws.Sort
            .SetRange ws.Range("A" & vArr(j, 1) & ":B" & vArr(j, 2))
            .Header = xlYes
            .MatchCase = False '
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            Application.ScreenUpdating = False
            .Apply
            Application.ScreenUpdating = True
        End With
    Next j
    
    Set rng = Nothing
    Set ws = Nothing
    End Sub

    Utilizzando il sito, accetti l'utilizzo dei cookie da parte nostra. maggiori informazioni

    Questo sito utilizza i cookie per fornire la migliore esperienza di navigazione possibile. Continuando a utilizzare questo sito senza modificare le impostazioni dei cookie o cliccando su "Accetta" permetti il loro utilizzo.

    Chiudi