EXCEL Aiuto Macro

[Francesco53]

Buongiorno a tutto il Forum,

ho cercato di realizzare la seguente macro:

Codice: Seleziona tutto

Sub Cerca()
    Conta = 0
      For R = 4 To 23
        If Cells(7, R).Value = 0 Then
            Conta = Conta + 1
            Cells(9, R).Value = Cells(6, R)
           Else
            If Conta > 10 Then
              For I = 1 To Conta
                 Cells(9, 3 + I).Value = 0
              Next
              Conta = 0
            End If
         End If
    Next
End Sub

ma non funziona a dovere.
Allego figura per vedere il foglio di ricerca dove, si evidenziano con un 1 i numeri ricercati del range G3:I3.
La macro dovrebbe contare gli zeri della riga 7, iniziando dalla colonna D, è evidenziare nella riga 9 tutti quei
numeri che anno nella cella superiore in riga 7 uno 0.
Deve scrivere le seguenze di numeri consecutivi come posizione, solo se la progressione non supera 10.
Spero nei due esempi postati di rendere chiaro il tutto.
Grazie a chi può aiutarmi.
Francesco

[Avatar3]

Ma la distribuzione dei dati è come l'hai riprodotta in foto?

oppure i numeri sono su unica riga?

[Francesco53]

Ciao Avatar3,
si i dati sono dalla cella D6 alla cella W6, la seconda figura è un ulteriore esempio di quello che mi serve.
Nella riga 7, ho messo una formula per segnarmi con 1 i numeri presenti da G3 a I3, la riga 8 mi conta gli
spazi dal num 1 all'altro num1, oppure dall'inizio al primo num 1.
Ho bisogno di scrivermi nella riga 9, i numeri della riga 6 che abbiano 0 nella riga 7, una seguenza non
superiore a 10 posizioni contigue, indipendentemente dalla loro posizione di inizio.
Spero di essere riuscito a spiegarmi, la macro conta i numeri 0 e trascrive il numero dalla riga 6 alla riga 9,
nella immagine le posizioni in azzurro, la figura riporta numeri di conteggio e non quelli giusti.
Se non è chioaro, invio file.
Francesco

[Francesco53]

Ciao Avatar,
ho risolto modificando la macro che avevo creato. Gli insegnamenti appresi da questo Forum, mi hanno consentito
di ragionare e risolvere l'errore che commettevo.
Posto la macro per chi interessato, non sarà il meglio di quanto si poteva fare, ma da autodidatta sono soddisfatto.

Codice: Seleziona tutto

Sub Cerca()
    Conta = 0
      For R = 4 To 23
        If Cells(7, R).Value = 0 Then
            Conta = Conta + 1
            Cells(9, R).Value = Cells(6, R)
           Else
            If Conta > 10 Then
              For I = 0 To Conta
                  Cells(9, R - Conta + I).Value = ""
              Next
            End If
            Conta = 0
         End If
      Next
End Sub

Grazie
Francesco

[Avatar3]

Sicuramente avrai usato delle formule nelle righe 7, 8, 19, 20
e la macro da te realizzata è finalizzata lle righe 10 e 21

Avevo capito che occorresse una macro che compilasse le 6 righe sopra descritte e ho impiegato un po' di tempo per realizzarla, a lavoro fatto vale la pena pubblicarla

Codice: Seleziona tutto

Public RRR, CCC As Integer
Sub Compila()

Range("D7:W7").Value = 0
Range("D19:W19").Value = 0
Num1 = 0
Num2 = 0
For CN = 7 To 9
    NCN = Cells(3, CN).Value
    For RR = 6 To 18 Step 12
        For CC = 4 To 23
            If Cells(RR, CC).Value = NCN Then
                Cells(RR + 1, CC).Value = 1
            End If
        Next CC
    Next RR
Next CN
Num1 = 0
    For RR = 7 To 19 Step 12
        For CC = 4 To 23
            If Cells(RR, CC).Value = 1 Then
                Num1 = 0
                Else
                Num1 = Num1 + 1
            End If
            Cells(RR + 1, CC).Value = Num1
        Next CC
    Next RR

Num2 = 0
    For RR = 8 To 20 Step 12
        For CC = 4 To 23
        Num2 = Num2 + 1
        Cells(RR + 1, CC).Value = Num2
            If Cells(RR, CC).Value = 0 Then
            Cells(RR + 1, CC).Value = ""
            End If
        Next CC
    Next RR

Conta = 0
    For RR = 9 To 21 Step 12
        For CC = 4 To 23
        If CC = 4 And Conta = 0 Then CCC = 4
        Conta = Conta + 1
        If Cells(RR, CC).Value = "" Then
        Conta = 0
        CCC = CC + 1
        RRR = RR
        End If
            If Conta > 10 Then
            Call Cancella
            End If
        Next CC
    Next RR


End Sub
Sub Cancella()
For RRC = RRR To 21 Step 12
    For CCR = CCC To 23
    If Cells(RRC, CCR).Value <> "" Then
    Cells(RRC, CCR).ClearContents
    Else
    Exit Sub
    End If
    Next CCR
    If RRC = 9 Then CCC = 4
Next RRC
End Sub


Ciao

[Francesco53]

Buongiorno Avatar,
ti ringrazio per la macro, cercherò di studiarla per migliorare le mie conoscenze.
L'ho provata è funziona, adesso la adatto alla mia ricerca.
Francesco