Pagina 1 di 1
[Risolto] Elaborazione tabella ed eliminazione colonne vuote
Inviato: mercoledì 15 marzo 2017, 13:36
da FireFighter
Odiatemi.... ma visto che mi risolvete un sacco di problemi.... vi chiedo ancora una cosa.... (premetto che mi state insegnando un sacco di cose!!!!!
)
In allegato trovate un file e il risultato che vorrei ottenere, non so se serve per forza una macro...
Sul foglio prova: intestazione sulla prima riga e sulla prima colonna.
Sul foglio Risultato: vorrei ottenere (immettendo i valori (Es: 1a)) nelle colonne successive che vengano inseriti, i valori se diversi da 0)
L'obbiettivo finale è creare delle "minitabelle" dove risulteranno dove sono presenti i valori a-b-c-d.... nei vari 1a-2a-3a....
Inizialmente ho provato a farlo con il SE.... ma ovviamente non mi elimina le celle vuote...
Re: Elaborazione tabella ed eliminazione colonne vuote
Inviato: mercoledì 15 marzo 2017, 17:54
da lucky63
Codice: Seleziona tutto
Sub TabellaSoloMaggioriZero
doc = thiscomponent ' il documento in uso
Sh1 = Doc.Sheets(0) ' il primo foglio
Sh2 = Doc.Sheets(1) ' il secondo foglio
Rem Rileva ultima colonna foglio 1
c = Sh1.createCursor
c.gotoEndOfUsedArea(false)
LastColumn = c.RangeAddress.EndColumn
Rem Inizializza contatori per posizioni su foglio 2
Contatore1 = 1
Contatore2 = 1
Rem Inizio ciclo
For X = 0 to LastColumn
Rem Verifica colonna in lettura
If x = 0 then
Rem riscontro per prima colonna (X=0) scrivi relativi dati
Sh2.getCellByPosition(0,1).String = Sh1.getCellByPosition(0, 2).String
Sh2.getCellByPosition(0,4).String = Sh1.getCellByPosition(0, 3).String
else
Rem riscontro per colonne successive (X>0) scrivi relativi dati
Rem Verifica nel PRIMO BLOCCO DATI FOGLIO PROVA se valore diverso da zero
if Sh1.getCellByPosition(x, 2).value <> 0 then
Rem Con riscontro valore letto > 0 legge i dati dal primo foglio e li scrive nel secondo
Sh2.getCellByPosition(Contatore1,0).String = Sh1.getCellByPosition(x, 1).String
Sh2.getCellByPosition(Contatore1,1).Value = Sh1.getCellByPosition(x, 2).value
Rem incremento contatore posizione PRIMO blocco
contatore1 = contatore1 +1
end if
Rem Verifica nel SECONDO BLOCCO DATI FOGLIO PROVA se valore diverso da zero
if Sh1.getCellByPosition(x, 3).value <> 0 then
Sh2.getCellByPosition(Contatore2,3).String = Sh1.getCellByPosition(x, 1).String
Sh2.getCellByPosition(Contatore2,4).Value = Sh1.getCellByPosition(x, 3).value
Rem incremento contatore posizione PRIMO blocco
contatore2 = contatore2 +1
end if
End if
Next
end sub
Re: Elaborazione tabella ed eliminazione colonne vuote
Inviato: mercoledì 15 marzo 2017, 22:42
da FireFighter
Diciamo che sto capendo... infatti....sono riuscito a modificare i due fogli da cui pesca... ma, essendo nuovo nel mondo macro... se la colonna A avesse 35 valori invece di 2.... dove devo modificare la macro?
Re: Elaborazione tabella ed eliminazione colonne vuote
Inviato: giovedì 16 marzo 2017, 2:06
da lucky63
Codice: Seleziona tutto
Sub TabellaSoloMaggioriZero
doc = thiscomponent ' il documento in uso
Sh1 = Doc.Sheets(0) ' il primo foglio
Sh2 = Doc.Sheets(1) ' il secondo foglio
Rem Rileva ultima COLONNA e uiltima RIGA foglio 1
c = Sh1.createCursor
c.gotoEndOfUsedArea(false)
UltimaColonna = c.RangeAddress.EndColumn
UltimaRiga = c.RangeAddress.EndRow
Rem Inizializza contatore RIGA
ContatoreRiga = 1
Rem Inizio ciclo conteggio RIGA
For riga = 2 to UltimaRiga
Rem Scrivi Le corrispondenze della prima colonna
Sh2.getCellByPosition(0,ContatoreRiga).String = Sh1.getCellByPosition(0, Riga).String
Rem Inizializza contatore riscontri COLONNA
ContatoreColonna = 1
Rem Inizia ciclo conteggio COLONNA
For x = 1 to UltimaColonna
Rem Verifica contenuto cella
if Sh1.getCellByPosition(x,Riga).value <> 0 then
Rem Caso riscontro scrivi le relative corrispondenze nel secondo foglio
Sh2.getCellByPosition(ContatoreColonna,ContatoreRiga -1).String = Sh1.getCellByPosition(X, 1).String
Sh2.getCellByPosition(ContatoreColonna,ContatoreRiga).String = Sh1.getCellByPosition(X, Riga).String
ContatoreColonna = ContatoreColonna +1
End if
Next
Rem Incrementa contatore RIGA
ContatoreRiga = ContatoreRiga + 3
Next
End sub