Inserire riga se soddisfatta condizione

Hai un problema con Excel?

Nuova discussione

Inserire riga se soddisfatta condizione
di gnukt (utente non iscritto) data: 02/10/2017 16:48:11
Ciao a tutti!!
Vorrei cortesemente chiedere il vostro aiuto! Avrei bisogno di una macro che inserisca una riga per coprire dei buchi di valori, ossia (come visualizzabile dal file di esempio allegato) per ogni regione e per ogni mese, se non sia presente una classe di consumo aggiungerla.

Spero di essermi spiegato o ad ogni modo di aver chiarito nel file ciò di cui ho bisogno.

Grazie mille!!!
di Luca73 data: 03/10/2017 17:24:01
Sinceramente non ho capito il criterio di aggiunta delle righe.
Perché con il 17 si arriva fino a 7 nell'ultima colonna (codice_classe_consumo) mentre con il 15 si arriva solo a 5?
Perchè con l 5 non esiste codice_classe_consumo = 3 mentre con il 17 c'è?
Se la logica fosse chiara non vedo difficolta nel fare ciò che hai chiesto.

Ciao
Luca
di gnukt (utente non iscritto) data: 05/10/2017 09:58:08
Grazie per la risposta. In effetti non mi sono spiegato bene...chiedo scusa.

Innanzitutto non è necessario che le regioni (colonna A) debbano avere necessariamente le stesse classi_di_consumo (colonna C), ecco perché "con il 17 si arriva fino a 7 nell'ultima colonna (codice_classe_consumo) mentre con il 15 si arriva solo a 5", e soprattutto non è detto che siano consecutive, nel senso che magari potrà esserci classe_di_consumo =1 e poi subito dopo classe_di_consumo =3.

Ciò di cui ho bisogno è un metodo che, per ogni regione (colonna A), se in un mese (colonna B) è presente un classe di consumo (colonna C) che non sia presente negli altri mesi, allora inserire una riga laddove manchi (come evidenziato in giallo nel file) , in modo tale che per quella regione ci sia lo stesso numero di mesi.

Spero di essere stato più chiaro.
Grazie in anticipo!
di Luca73 data: 05/10/2017 10:54:17
Se ho capito bene quindi la 17/3/7 l'hai inserita in quanto avevi la 17/1/7 e la 17/2/7
Quindi codice_regione e id_mese non vanno aggiunti
Quindi per ogni mese di ogni regione devo aggiungere una riga per ogni codice_classe_consumo presenti in altri mese delle stesso regione

Corretto?
Ciao
Luca
di Luca73 data: 05/10/2017 11:50:49
Ho una ulteriore domanda.
E' una operazione che fai spesso oppure raramente e di quante righe parliamo?
iusto per capire se cercare di ootimizzare il codice o farlo in maniera un po' "brutale" e non ottimizzata.

Ciao
Luca
di gnukt (utente non iscritto) data: 10/10/2017 12:01:22
Ciao Luca73, ti ringrazio per le risposte e scusa il ritardo.

"Se ho capito bene quindi la 17/3/7 l'hai inserita in quanto avevi la 17/1/7 e la 17/2/7
Quindi codice_regione e id_mese non vanno aggiunti
Quindi per ogni mese di ogni regione devo aggiungere una riga per ogni codice_classe_consumo presenti in altri mese delle stesso regione

Corretto?"

Esattamente così!
Alla fine le righe si aggirerebbero su di max di 300, quindi il codice può essere tranquillamente anche non particolarmente ottimizzato.

Ti ringrazio per la disponibilità!

di Luca73 data: 10/10/2017 16:54:03
Ciao
ho buttato giù il programmino qui sotto
Prova a vedere se funziona correttamente
Ciao
Luca

Sub ProvaLuca()

    Dim MioRangeL
    Dim MiaCellaW1
    Dim DaAggiungere()
    Dim Vettore()
    Dim Indice As Integer
    Dim Index2 As Integer
    Dim MiaCella As Range
    Dim Trovato As Boolean
    Dim UltimaCella As Range
    Dim PrimaCella As Range
    
    Set MiaCellaW1 = Range("A2")
    Set MioRangeL = Range(MiaCellaW1.Offset(1, 0), MiaCellaW1.Offset(1, 0).End(xlToRight).End(xlDown))
    MioRangeL.Select
    ActiveWorkbook.Worksheets("Foglio2").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Foglio2").Sort.SortFields.Add Key:=Intersect(MioRangeL, MioRangeL.Columns(1)) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortTextAsNumbers
    ActiveWorkbook.Worksheets("Foglio2").Sort.SortFields.Add Key:=Intersect(MioRangeL, MioRangeL.Columns(2)) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Foglio2").Sort.SortFields.Add Key:=Intersect(MioRangeL, MioRangeL.Columns(3)) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    
    With ActiveWorkbook.Worksheets("Foglio2").Sort
        .SetRange MioRangeL
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    Set UltimaCella = MioRangeL.Cells(1, 1)
    ReDim DaAggiungere(1 To 3, 0)
    Set PrimaCella = MioRangeL.Cells(1, 1)
Do
    ReDim Vettore(1 To 2, 0)
    Do
        Set MiaCella = UltimaCella
        MiaCella.Select
        If UBound(Vettore, 2) = 0 Then
            ReDim Vettore(1 To 2, 1)
            Vettore(1, 1) = MiaCella.Offset(0, 2)
        Else
            Trovato = False
            For Indice = 1 To UBound(Vettore, 2)
                If Vettore(1, Indice) = MiaCella.Offset(0, 2) Then
                Trovato = True
                Exit For
                End If
            Next
            If Not Trovato Then
                ReDim Preserve Vettore(1 To 2, UBound(Vettore, 2) + 1)
                Vettore(1, UBound(Vettore, 2)) = MiaCella.Offset(0, 2)
            End If
        End If
        Set MiaCella = MiaCella.Offset(1, 0)
        Set UltimaCella = MiaCella
    Loop While MiaCella = MiaCella.Offset(-1, 0)
Set MiaCella = PrimaCella
        Do
            For Indice = 1 To UBound(Vettore, 2)
                Vettore(2, Indice) = False
            Next Indice
            Do
                MiaCella.Select
                For Indice = 1 To UBound(Vettore, 2)
                    If Vettore(1, Indice) = MiaCella.Offset(0, 2) Then
                        Vettore(2, Indice) = True
                    End If
                Next Indice
                Set MiaCella = MiaCella.Offset(1, 0)
            Loop While MiaCella.Offset(-1, 1) = MiaCella.Offset(0, 1)
            For Indice = 1 To UBound(Vettore, 2)
                If Vettore(2, Indice) = False Then
                    ReDim Preserve DaAggiungere(1 To 3, UBound(DaAggiungere, 2) + 1)
                        DaAggiungere(1, UBound(DaAggiungere, 2)) = MiaCella.Offset(-1, 0)
                        DaAggiungere(2, UBound(DaAggiungere, 2)) = MiaCella.Offset(-1, 1)
                        DaAggiungere(3, UBound(DaAggiungere, 2)) = Vettore(1, Indice)
                End If
            Next Indice

           
            'Set MiaCella = MiaCella.Offset(1, 0)
            Set PrimaCella = UltimaCella.Offset(1, 0)
            Set UltimaCella = MiaCella
        Loop While MiaCella.Offset(-1, 0) = MiaCella
    Loop While MiaCella.Offset(1, 0) <> ""
'   MsgBox "pippo"
UltimaCella.Select
For Indice = 1 To UBound(DaAggiungere, 2)
    For Index2 = 1 To 3
        UltimaCella.Offset(Indice - 1, Index2 - 1) = DaAggiungere(Index2, Indice)
    Next
Next
Range(UltimaCella.Offset(-1, 0), UltimaCella.Offset(-1, 2)).Copy
With Range(UltimaCella, UltimaCella.Offset(UBound(DaAggiungere, 2) - 1, 3 - 1))
.Select
    .PasteSpecial _
        Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
        With .Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .Color = 65535
            .TintAndShade = 0
            .PatternTintAndShade = 0
        End With
    End With
    
Set MioRangeL = Range("A2")
    
    Set MioRangeL = Range(MioRangeL.Offset(1, 0), MioRangeL.Offset(1, 0).End(xlToRight).End(xlDown))
    
    MioRangeL.Select
    ActiveWorkbook.Worksheets("Foglio2").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Foglio2").Sort.SortFields.Add Key:=Intersect(MioRangeL, MioRangeL.Columns(1)) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortTextAsNumbers
    ActiveWorkbook.Worksheets("Foglio2").Sort.SortFields.Add Key:=Intersect(MioRangeL, MioRangeL.Columns(2)) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Foglio2").Sort.SortFields.Add Key:=Intersect(MioRangeL, MioRangeL.Columns(3)) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    
    With ActiveWorkbook.Worksheets("Foglio2").Sort
        .SetRange MioRangeL
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
 Set MioRangeL = Range(MiaCellaW1.Offset(1, 0), MiaCellaW1.Offset(1, 0).End(xlToRight).End(xlDown))
    MioRangeL.Select
    ActiveWorkbook.Worksheets("Foglio2").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Foglio2").Sort.SortFields.Add Key:=Intersect(MioRangeL, MioRangeL.Columns(1)) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortTextAsNumbers
    ActiveWorkbook.Worksheets("Foglio2").Sort.SortFields.Add Key:=Intersect(MioRangeL, MioRangeL.Columns(2)) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Foglio2").Sort.SortFields.Add Key:=Intersect(MioRangeL, MioRangeL.Columns(3)) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    
    With ActiveWorkbook.Worksheets("Foglio2").Sort
        .SetRange MioRangeL
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

di gnukt (utente non iscritto) data: 16/10/2017 10:16:58
Grazie mille!!
Funziona perfettamente!
Gentilissimo!!!

Vuoi Approfondire?