cancellare righe con valori in colonna j vuoti

[tecnuf]

salve ,
ho questo semplice problema (ma per me compilcato)
alla fine di una macro che ...mi avete confezionato voglio andare a cancellare tutte le
righe per le quali nella colonna BB ho valore zero o celle vuote (penso siano cose diverse)
è possibile?

[Anthony47]

Devi fare un loop dall'ultima riga alla prima, e all'interno di questo controllerai il contenuto di colonna BB; del tipo

Codice: Seleziona tutto

For I=Cells(Rows.count, "A").End(xlup).Row to 2 step -1
    If Cells(I, "BB").Value = 0 or Cells(I, "BB").Value = "" then
        Rows(I).Delete Shift:=xlUp
    End If
Next I

Ciao

[Luca Gambini]

Buongiorno Anthony,

scusate se riapro un vecchio post.
La macro funziona e l'ho adattata alle mie esigenze.
é solo molto lenta (credo perché controlla tutte le righe della colonna).

Ho provato a impostare la seguente macro



Dim lngNumeroRiga As Long
Dim lngLong As Long

With ActiveSheet

lngNumeroRiga = .Range("A200").End(xlUp).Row

For lngLong = lngNumeroRiga To 1 Step -1
If .Cells(lngLong, 1).Value = "" Then
.Rows(lngLong).Delete Shift:=xlUp
End If
Next lngLong

.Cells(1, 1).Select

End With
End Sub

Vorrei chiedere un aiuto per 2 cose:
Cancella le righe in colonna A in cui in A nun c'è nulla, ma non quelle che hanno valori in B e posizionate dopo l'ultimo valore presente in A (partendo dall'alto).
Per essere chiari cancella le righe tra A1 e A67.
In A68, A69 e a seguire non ci sono valori, ma ci sono in B68, B69, B70 ecc. Dovrebbero essere cancellate anche queste righe.
Dove sbaglio?
Sono sicuro che non vi sono spazi e/o caratteri nascosti.

E' comunque lenta.... Non è un problema, sia chiaro.
Solo vorrei sapere se c' modo di velocizzarla

Grazie1000
Nel mio caso

[Anthony47]

Ciao Luca Gambini, benvenuto nel forum.
Mi par di capire che hai un'esigenza leggermente diversa (le colonne da controllare), oltre che il problema di velocita'.
Prima di guardare la velocita' allega un file di esempio su cui lavorare e spiega ancora, seguendo il contenuto del file, che cosa controllare per decidere cosa eliminare e cosa no.
Per le istruzioni su come allegare un file:
viewtopic.php?f=26&t=103893&p=605487#p605487

Ciao

[Luca Gambini]

Ciao Anthony, grazie.
i ho provato tutto ieri e stamane, ma non ci arrivo.
Ho fatto un po' di macro (veramente basic e più che altro somma di operazioni semplici e farraginose).
Fino a un certo punto, pezzo per pezzo, vanno.

Manca una macro che:
1) dal foglio LIST filtra per Autore della recensione (OK ci riesco)
2) copia i valori filtrati in altra porzione di foglio (OK, riesco)
3) chiude il filtro ed elimina le righe vuote che ovviamente si creano dopo avere incollato (Fatto, anche se non credo in modo ottimale, ma va)
4) copia il risultato del filtro, compattato e lo incolli su foglio BY author.
Qui mi incarto perché: devo posizionarmi in una cella che è variabile che non riesco a definire in VBA.
L'idea messa in pratica, in mancanza di conoscenze di programmazioni, è quella di cancellare ogni volta i dati in BY Author, lasciando la parte di grafica esistente (per farlo ho aggiunto una colonna a dx "A" in cui metto dei valori e poi cancello tutte le righe in cui non ci sia un valore iniziele in "Ax")
Metodo sicuramente lungo come routine, ma almeno va.....
Quantomeno mi garantisce che se in LIST cancello qualche riga (caso possibile) l'elenco nel report è aggiornato.

Come risolvo il punto 4?
Vedi per caso altre migliorie che caldeggi????

Qui il file
http://www.filedropper.com/esempio
Grazie, purtroppo non riesco da solo....

luca

[Anthony47]

Mi permetto di suggerire una macro che partendo dal contenuto del foglio LIST crea il foglio byAuthor, credo in un formato abbastanza simile al tuo.
La macro che fa cio' e' la Sub Distrib localizzata su Modulo111 nel file che e' scaricabile qui:
https://www.dropbox.com/s/tbh182ewmiswj ... .xlsm?dl=0

Il codice della macro:

Codice: Seleziona tutto

Sub Distrib()
Dim myList As Worksheet, byA As Worksheet
Dim I As Long, cAuth As String, J As Long, myNext As Long, myMatch
'
Set myList = Sheets("LIST")
Set byA = Sheets("BY author")
'
byA.Range("A:F").Clear
With myList
    For I = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
        cAuth = .Cells(I, 1)
        myMatch = Application.Match(cAuth, byA.Range("A:A"), 0)
        If IsError(myMatch) Then
            myNext = byA.Cells(Rows.Count, 2).End(xlUp).Row + 2
            If myNext < 4 Then myNext = 1
            byA.Range("block").Copy byA.Cells(myNext, 1)
            byA.Cells(myNext + 1, 1).Value = cAuth
            myMatch = myNext + 1
        End If
        For J = 1 To 1000
            If byA.Cells(myMatch + 1 + J, 2) = "" Then
                myNext = myMatch + 1 + J
                Exit For
            End If
        Next J
        .Cells(I, 2).Resize(1, 4).Copy byA.Cells(myNext, 2)
        byA.Cells(myNext, 1) = "o"
        byA.Cells(myNext + 1, 1).Resize(1, 6).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Next I
End With
MsgBox ("Completato...")
End Sub


Attualmente la macro AZZERA senza preavviso le colonne A:F del foglio ByAuthor e ricrea l'elenco.
Per fare questo ho inserito in K1 e adiacenti sempre di ByAuthor una copia del "blocco" di informazioni da creare per ogni Autore, che poi andro' a inserire nella posizione giusta.
Se il processo fosse diverso, tipo il nuovo elenco di dati in LIST va accodato all'elenco eventualmente gia' presente in byAuthor, allora saranno necessari un paio di interventi.

Vedi intanto se quanto fatto e' di tuo interesse, e poi ne parliamo.

Ciao

[Luca Gambini]

Grazie!!
Va alla grande. Sono contentissimo.
Per il foglio LIST non ci sono problemi. L'elenco è aggiornato di continuo ed eventuali duplicati li evidenzio con una formattazione condizionale e li sistemo a mano.
Vedo che se cancello una riga crea dei blocchi vuoti. Questo lo sistemo con una macro che ordina i valori a monte e risolvo.

Vorrei una mano per un un'ultima cosa (scusa se ne approfitto così tanto). Solo se non ti porta via troppo tempo.

Nel foglio "BY Author" l'intestazione di blocco prende da A2 a F2

Vorrei che prendesse (ma solo quello) da B2 a D2,
Questo perché in E1, E2. E3, vorrei aggiungere, rispettivamente Autore, Conteggio Hotel, "Recensioni" (come testo).
Su questo punto pesavo di usare la funzione =CONTA.SE(LIST!$A:$A;G1), ma cancellando ogni volta il foglio mi saltano i riferimenti....

Sarebbe poi difficile aggiungere sull'intestazione (quella colorata, al centro del blocco B:E la foto dell'autore??????
GRAZIE !!

[Anthony47]

Per evitare di avere un blocco vuoto in caso di riga vuota su LIST, inserire il corpo del codice in un If /End If; questo il cuore della macro modificata:

Codice: Seleziona tutto

With myList
    For I = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
        cAuth = .Cells(I, 1)
        If cAuth <> "" Then
            myMatch = Application.Match(cAuth, byA.Range("A:A"), 0)
            If IsError(myMatch) Then
                myNext = byA.Cells(Rows.Count, 2).End(xlUp).Row + 2
                If myNext < 4 Then myNext = 1
                byA.Range("block").Copy byA.Cells(myNext, 1)
                byA.Cells(myNext + 1, 1).Value = cAuth
                myMatch = myNext + 1
            End If
            For J = 1 To 1000
                If byA.Cells(myMatch + 1 + J, 2) = "" Then
                    myNext = myMatch + 1 + J
                    Exit For
                End If
            Next J
            .Cells(I, 2).Resize(1, 4).Copy byA.Cells(myNext, 2)
            byA.Cells(myNext, 1) = "o"
            byA.Cells(myNext + 1, 1).Resize(1, 6).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        End If
    Next I
End With


Per modificare le celle unite occupate dall'intestazione del blocco, vai sulla copia in K2:O2 e reimposta le celle unite su K2:N2; poi ripeti la creazione di ByAuthor.
Queste modifiche sono ora inserite nel file pubblicato su Dropbox.

Se vuoi mettere delle formule in E1, E2, ed E3 allora anche queste vanno inserite nella "copia" presente in K1 e adiacenti (in O1, O2 e O3).
In E1 vuoi mettere l' Autore, ma questa info non e' gia' presente nell'intestazione del blocco (l'area che abbiamo ristretto di 1 colonna)? Che c'entra "G1" (nella formula =CONTA.SE(LIST!$A:$A;G1))? Ne' ho capito che cosa vorresti inserire in E2 (Conteggio hotel) ed E3 ("Recensioni").
Se spieghi queste cose vedremo quali formule mettere.
Quanto ad aggiungere una immagine, si puo' fare: fai una google search usando la stringa

Codice: Seleziona tutto

 Shapes.AddPicture site:pc-facile.com

Poi prova a realizzare qualcosa usando i suggerimenti che trovi nelle discussioni linkate.

Ciao

[Luca Gambini]

grazie, sono riuscito a sistemare formule e codice.

Per quanto riguarda lo sfizio delle immagini, mi piacerebbe che al centro di ogni blocco comparisse la faccia di chi ha fatto le recensioni.
Le immagini le ho salvate tutte in un ultimo foglio del file.

Il sistema proposto e la quasi totalità delle soluzioni trovate in rete, sfruttano la proprietà "visibile" di una immagine.
Purtroppo io l'immagine la vorrei in una posizione variabile, quella del blocco, e non in una cella predeterminata.
Inoltre, se non intendo male, ammesso e non concesso di sfruttare questa proprietà, dovrei inserire tutte le facce per ogni blocco, rendendo visibile solo quelle che servono.
Però così facendo anziché inserirne 18 (gli autori), dovrei inserirne 18 x numero.blocchi....
Mi aiuteresti con questo ultimo punto per favore? Poi me ne starò quieto....

[Anthony47]

Si puo' fare, ma stasera il tempo e' tiranno; domani e' peggio; vedro' cosa posso fare...

[Luca Gambini]

ciao!
già mi aiuti.... Ci mancherebbe che pretendessi o mettessi fretta!
Nel frattempo ci provo anche da solo.
Una soluzione orrenda l'ho abbozzata mettendo le immagini come sfondo dei commenti, i commenti sempre visibili e con tappeto di cerca.vert in tutto il foglio compare qualcosa (ovviamente con dimensioni random e distorsioni da incubo).
grazie. Già essere nel forum è comunque uno stimolo ad arrangiarsi e provare. Si impara sempre qualcosa che verrà utile un domani.

[Anthony47]

Allora mi pare che hai 18 immagini da gestire (se fossero 30 non cambierebbe l'approccio).
Inserisci le immagini su foglio ByAuthor; ridimensionale piu' o meno alla dimensione che ti serviranno cosi' (se hai Excel 2010 o superiore) l'occupazione sul disco verra' contenuta in proporzione.
Man mano che le inserisci, Excel assegna ad esse un "nome" progressivo, che vedi nella "Casella Nome" (quella che si vede a sx, subito sopra le intestazioni di colonna); premi la "freccia giù" e assegna a ogni immagine il nome "ZCZC_NomeAutore". Come "NomeAutore" usa la stessa scritta che comparira' nella riga di intestazione.
Inserisci anche una immagine senza volto, che verra' usata nel caso che l'immagine dell'Autore non ancora presente, e rinominala "ZCZC_NN". Questa immagine e' l'unica obbligatoria, se non esiste la macro si terminera' con messaggio di errore.

A questo punto usa la seguente macro, in alternativa alla precedente Sub Distrib (che invece va usata se le immagini non sono inserite):

Codice: Seleziona tutto

Sub DistribImm()
'Gestisce Immagine autore
Dim myList As Worksheet, byA As Worksheet
Dim I As Long, cAuth As String, J As Long, myNext As Long, myMatch
'
Set myList = Sheets("LIST")
Set byA = Sheets("BY author")
'
byA.Select
On Error GoTo gExit
    ActiveSheet.Shapes("ZCZC_NN").Visible = False
On Error GoTo 0
For I = ActiveSheet.Shapes.Count To 1 Step -1
    If Left(ActiveSheet.Shapes(I).Name, 10) = "ZCZC__COPY" Then
        ActiveSheet.Shapes(I).Delete
    ElseIf Left(ActiveSheet.Shapes(I).Name, 5) = "ZCZC_" Then
        ActiveSheet.Shapes(I).Visible = False
    End If
Next I
'
byA.Range("A:F").Clear
With myList
    For I = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
        cAuth = .Cells(I, 1)
        If cAuth <> "" Then
            myMatch = Application.Match(cAuth, byA.Range("A:A"), 0)
            If IsError(myMatch) Then
                myNext = byA.Cells(Rows.Count, 2).End(xlUp).Row + 2
                If myNext < 4 Then myNext = 1
                On Error Resume Next
                    myn = "":  myn = ActiveSheet.Shapes("ZCZC_" & cAuth).Name
                On Error GoTo 0
                If myn = "" Then
                    ActiveSheet.Shapes.Range(Array("ZCZC_NN")).Visible = True
                    ActiveSheet.Shapes.Range(Array("ZCZC_NN")).Select
                    Selection.Copy
                    Cells(myNext, 2).Select
                    ActiveSheet.Paste
                    Selection.Name = "ZCZC__COPY" & myNext
                    myn = "ZCZC__COPY" & myNext
                    ActiveSheet.Shapes.Range(Array("ZCZC_NN")).Visible = False
                Else
                    myn = "ZCZC_" & cAuth
                End If
                With ActiveSheet.Shapes(myn)
                    .Visible = True
                    .Top = Cells(myNext, 2).Top
                    .Left = Cells(1, 2).Left
                    .LockAspectRatio = True
                    .Height = Cells(myNext, 2).Resize(3, 1).Height
                    If .Width > Cells(1, 2).Width Then .Width = Cells(1, 2).Width
                    Cells(myNext, 1).Select
                End With
                byA.Range("block").Copy byA.Cells(myNext, 1)
                byA.Cells(myNext + 1, 1).Value = cAuth
                myMatch = myNext + 1
            End If
            For J = 1 To 1000
                If byA.Cells(myMatch + 1 + J, 2) = "" Then
                    myNext = myMatch + 1 + J
                    Exit For
                End If
            Next J
            .Cells(I, 2).Resize(1, 4).Copy byA.Cells(myNext, 2)
            byA.Cells(myNext, 1) = "o"
            byA.Cells(myNext + 1, 1).Resize(1, 6).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        End If
    Next I
End With
MsgBox ("Completato...")
Exit Sub
gExit:
MsgBox ("Non ho trovato la foto di default, procedura abortita" & vbCrLf & _
  "(usa Sub Distrib per creare una lista senza immagini")
End Sub


Il file disponibile su Dropbox contiene ora anche questa seconda macro, da usare in alternativa alla precedente Sub Distrib.

Prova e fai sapere il risultato.

Ciao

[Luca Gambini]

Ti ringrazio davvero tanto per quanto sei stato disponibile.
A buon rendere !!