Condividi:        

Copia valore sino a quando il valore non cambia!

Vuoi potenziare i tuoi documenti Word? Non sai come si fa una macro in Excel? Devi creare una presentazione in PowerPoint?
Oppure sei passato a OpenOffice e non sei sicuro di come lavorare al meglio?

Moderatori: Anthony47, Flash30005

Copia valore sino a quando il valore non cambia!

Postdi deniel69 » 13/11/14 18:50

Buon giorno a tutti.

Eccomi ancora qui con un nuovo quesito.

Avrei bisogno di scrivere una macro che legga i dati contenuti in una colonna esempio "D" partendo da riga 1
legga il primo valore che trova, lo memorizzi nella variabile e lo copi nelle celle sottostanti.
Quando il valore cambia, memorizzi il nuovo valore e continui a copiare
Tutto questo sino ad una determinata riga, esempio riga 200.

Ho cercato e trovato quanto segue ma non riesco a capire come adattarlo alle mie esigenze.

Sub copia()
c = 3 ' colonna inizio scrittura
r1 = 1 ' riga inizio scrittura
r = 1 ' riga inizio dati e controllo fine dati
v = Cells(r, 1)
Do Until Cells(r, 1) = ""
If Cells(r, 1) = v Then ' se il valore è uguale
Cells(r1, c) = Cells(r, 2) ' scrive in colonna
Else ' altrimenti
v = Cells(r, 1) ' prende il nuovo valore
Cells(r1, c) = Cells(r, 2) ' scrive
End If
r1 = r1 + 1 ' incrementa riga scrittura
r = r + 1 ' incrementa riga lettura
Loop
End Sub


Grazie anticipato a tutti.......
Avatar utente
deniel69
Utente Senior
 
Post: 131
Iscritto il: 17/04/12 22:43

Sponsor
 

[EXCEL] Copia valore cella e incolla finché valore non cambi

Postdi Dylan666 » 13/11/14 23:07

Avevo una esigenza simile, ho tolto dei pezzi di codice che avevo in più guarda se ti funziona

Codice: Seleziona tutto
Sub test()

On Error GoTo RigaErrore

    'dichiaro le variabili
    Dim wk As Workbook
    Dim sh As Worksheet
    Dim rng As Range
    Dim c As Range

    'metto un riferimento al worksbook
    'che contiene il codice
    Set wk = ThisWorkbook

    'metto un riferimento al Foglio1
    With wk
        Set sh = .Worksheets("Foglio1")
    End With

    With sh
        'metto un riferimento al Range
        Set rng = .Range("D1:D50") '
        'ciclo il Range rng
        For Each c In rng
           
            If Len(c.Value) <> 0 Then 'Controlla se la riga non è vuota non fare nulla
            'MsgBox c.Address & " è piena."
               
            Else
            'MsgBox c.Address & " è vuota."
                c.Offset(-1, 0).Select 'Seleziona il valore della riga precedente
                Selection.Copy 'Taglia il valore
                c.Select
                ActiveSheet.Paste 'Incolla il valore
               
            End If
        Next
    End With

RigaChiusura:
    'Set a Nothing delle variabili oggetto
    Set c = Nothing
    Set rng = Nothing
    Set sh = Nothing
    Set wk = Nothing
    Exit Sub

RigaErrore:
    MsgBox Err.Number & vbNewLine & Err.Description & vbNewLine
    Resume RigaChiusura


End Sub


Sicuramente è migliorabile :P
Avatar utente
Dylan666
Moderatore
 
Post: 39988
Iscritto il: 18/11/03 16:46

Re: Copia valore sino a quando il valore non cambia!

Postdi deniel69 » 15/11/14 17:28

Ottimo.... Adattata usata e funzionante...... Come sempre ringrazio.........
Avatar utente
deniel69
Utente Senior
 
Post: 131
Iscritto il: 17/04/12 22:43

Re: [EXCEL] Copia valore cella e incolla finché valore non c

Postdi Dylan666 » 15/11/14 23:45

In realtà credo che la macro sarebbe un po' più veloce (e leggibile) modificata così:

Codice: Seleziona tutto
Sub test()

On Error GoTo RigaErrore

    'dichiaro le variabili
    Dim wk As Workbook
    Dim sh As Worksheet
    Dim rng As Range
    Dim c As Range

    'metto un riferimento al worksbook
    'che contiene il codice
    Set wk = ThisWorkbook

    'metto un riferimento al Foglio1
    With wk
        Set sh = .Worksheets("Foglio1")
    End With

    With sh
        'metto un riferimento al Range
        Set rng = .Range("D1:D50") '
        'ciclo il Range rng
        For Each c In rng
           
            If Len(c.Value) <> 0 Then 'Controlla se la riga non è vuota, e in tal caso copia
            'MsgBox c.Address & " è piena."
                c.Select
                Selection.Copy 'Copia il valore
               
            Else 'Controlla se la riga è vuota, e in tal caso incolla
            'MsgBox c.Address & " è vuota."
                c.Select
                ActiveSheet.Paste 'Incolla il valore
               
            End If
        Next
    End With

RigaChiusura:
    'Set a Nothing delle variabili oggetto
    Set c = Nothing
    Set rng = Nothing
    Set sh = Nothing
    Set wk = Nothing
    Exit Sub

RigaErrore:
    MsgBox Err.Number & vbNewLine & Err.Description & vbNewLine
    Resume RigaChiusura


End Sub


Ma sostanzialmente cambia poco! :P ;)
Avatar utente
Dylan666
Moderatore
 
Post: 39988
Iscritto il: 18/11/03 16:46

Re: Copia valore sino a quando il valore non cambia!

Postdi Anthony47 » 16/11/14 01:35

Anche questa:
Codice: Seleziona tutto
Sub replica()
Dim mystart As String, myLungh As Long, myOld
'
mystart = "C1"  '<< La cella di inizio
myLungh = 25    '<< Il numero di righe
'
myOld = ""
For I = 0 To myLungh - 1
    If Range(mystart).Offset(I, 0) = "" Then
        Range(mystart).Offset(I, 0) = myOld
    Else
        myOld = Range(mystart).Offset(I, 0)
    End If
Next I
End Sub

Le istruzioni marcate << sono da personalizzare.

Ciao a tutti
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea


Torna a Applicazioni Office Windows


Topic correlati a "Copia valore sino a quando il valore non cambia!":

BTp Valore
Autore: MarioLombardi
Forum: Forum off-topic
Risposte: 2

Chi c’è in linea

Visitano il forum: Nessuno e 137 ospiti