Copia valore se

[BG66]

Ciao a tutti,
nel Private Sub Worksheet_Change(ByVal Target As Range) del precedente thread:
http://www.pc-facile.com/forum/viewtopic.php?f=26&t=110402
volevo aggiungere per i valori del range E12:E4039 questa possibilità.
In pratica al momento devo digitare il valore "op" per ogni cella mentre vorrei che quando digito un valore in questa colonna dopo una o più celle vuote, lo script prenda il numero precedente e lo scriva se la cella adiacente (range D12:D4039) non è vuota.

Nello specifico: digitando 11 (in E21) il dato atteso è la compilazione con il numero 23 (quello precedente) solamente delle celle E13-E15-E17 (quelle che nella prima parte dello script sono state compilate e "congelate").
E precisamente:

Con tanto aiuto è questo lo script partorito:

Codice: Seleziona tutto

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Rng As Range, Rng2 As Range
    Dim rArea As Range
    Dim vVal As Variant

    On Error GoTo XIT
    Application.EnableEvents = False
    Set Rng = Me.Range("D12:E4039")
    If Not Intersect(Target, Rng.Columns(1)) Is Nothing _
       And Target.Count = 1 Then
       With Target
            If .Offset(0, 7).Value = "" Then
                .Offset(0, 7).Value = Now
                .Offset(0, 7).NumberFormat = "dd/mm/yyyy hh:mm:ss"
            End If
        End With
    ElseIf Not Intersect(Target, Rng.Columns(2)) Is Nothing Then 'Rng.Columns(2)
        With Rng.Columns(2) 'Rng.Columns(2)
            On Error Resume Next
            Set Rng2 = .Resize(Target.Row - .Row). _
                       SpecialCells(xlCellTypeBlanks)
            On Error GoTo XIT
            If Not Rng2 Is Nothing Then
                For Each rArea In Rng2.Areas 'Rng2.Areas
                    With rArea
                        vVal = .Cells(1).Offset(.Cells.Count).Value '.Cells(1)
                        If Not vVal = vbNullString Then
                            .Value = vVal
                        End If
                    End With
                Next rArea
            End If
        End With
    End If
XIT:
    Application.EnableEvents = True
End Sub


Ed ottengo:
1) che il numero riportato è l'ultimo digitato e non il precedente,
2) che il dato è scritto in tutte le celle vuote tra i due valori,
3) dulcis in fundo.....che se cancello il valore in E13 (solo per questa cella!!) mi compila le celle K1:K11 con data e orario -????


Sono impallato da qualche giorno.
https://www.dropbox.com/s/2cie6xg2qsvop3y/copia%20valore%20v2.xlsm?dl=0

E anticipatamente ringrazio per l'eventuale aiuto.

[Marius44]

Ciao Gene e buona domenica
Da una prima "assonnata" occhiata credo che l'errore stia nei punti seguenti:
in questa parte di codice togli le due righe che ho commentato e aggiungi le due righe segnate

'On Error Resume Next '<====== questa eliminata
Set Rng2 = .Resize(Target.Row - .Row). _
SpecialCells(xlCellTypeBlanks)
Rng2.Select '<======= questa aggiunta
Stop '<======= questa aggiunta
'On Error GoTo XIT '<====== questa eliminata
facendo girare il codice vedrai, arrivato allo stop, che sono selezionate le righe vuote della col.D fino al numero precedente che rimane fuori.
Proseguiamo: metti uno stop dopo questa riga di codice

vVal = .Cells(1).Offset(.Cells.Count).Value
Stop ' <===== questo aggiunto

Come potrai notare il valore assunto non è 23 ma 11

Proseguiamo ancora

If Not vVal = vbNullString Then
.Value = vVal
End If

Poiche ci troviamo in Rng2.Areas mi sembra ovvio che inserisca quel valore in tutte le celle vuote, mancando una condizione.

Tutto questo se ho capito il problema.
Ciao,
Mario

[BG66]

Ciao Mario,
da quando alle 6:52 sei assonnato?
Ovviamente hai centrato il problema ma sono giorni che le tento tutte e purtroppo il massimo è quello che vedi.
E, ahimè, le tue indicazioni mi hanno confermato le incongruenze ma non so come sistemarle.

Attendo tue se vuoi.
Gene

[Anthony47]

Mario deve essere finalmente andato a dormire
In attesa della sua venuta io propongo di modificare la seconda parte della Sub come segue:

Codice: Seleziona tutto

    ElseIf Not Intersect(Target, Rng.Columns(2)) Is Nothing And _
      Target.Count = 1 And Target.Value <> "" Then 'Rng.Columns(2)
        With Rng.Columns(2) 'Rng.Columns(2)
        Dim c2col, I
            c2col = Rng.Columns(2).Column
            For I = Target.Cells(1, 1).End(xlUp).Row To Target.Cells(1, 1).Row
                If Cells(I, c2col - 1) <> "" And Cells(I, c2col) = "" Then
                    Cells(I, c2col) = Target.Cells(1, 1).End(xlUp).Value
                End If
            Next I
        End With
    End If
XIT:
    Application.EnableEvents = True
End Sub


Le Dim puoi spostarle in alto. Come vedi mi limito a un ciclo For I /Next I in cui esamino le celle precedenti ed eventualmente compilo.
Quello di cui non sono certo e' quale e' la situazione di partenza, quindi se quando si compilera' per la prima volta una cella di colonna E il comportamento sara' come te lo aspetti. Al limite sara' da inserire un controllo che I sia maggiore di qualcosa che al momento non so immaginare quale debba essere (10? 11? ??)

Ciao

[Marius44]

Buon pomeriggio a tutti

No, non ero andato a dormire!
Ecco come sono andate le cose: ieri sera ho fatto le "ore piccole" e stamattina avevo "appuntamento" coi nipotini alle 08.00 per andare presso una fattoria (mucche, pecore, galline, maialini, ecc. oltre a piante, ortaggi, ecc.). Che faticata!

Ora che son tornato eccomi a voi.

Se posso permettermi un appunto a Anthony: Non devi dare la soluzione a Gene! Dopo tante pene commettere ancora errori così "ingenui" meriterebbe una "tiratina d'orecchi". Va beh, siamo buoni.

Un saluto a tutti,
Mario

[Anthony47]

Eh he... Gene e' l'utente perfetto per un forum: preparato abbastanza per mettersi in situazioni complesse, ma non abbastanza per uscirne sempre con le sue gambe

[BG66]

[RISOLTO]
Ciao a tutti,
è un piacere essere cosi... "stimato" e prometto che....non mancherò di infilarmi in qualche altro contorto ragionamento...

Scherzi a parte....Grazie mille e..... a presto

Gene