Pagina 1 di 1
[Risolto] cancella Righe con valori duplicati
Inviato: sabato 2 marzo 2019, 7:58
da chimico
Saluti ,
Ho trovato una grande macro di sr.
patel che copia nel foglio di lavoro 2 le righe senza duplicati .
nel mio progetto, non ho bisogno di copiare nel foglio di lavoro 2, ho solo bisogno di
eliminare le righe duplicate nel
foglio di lavoro 1, in modo che ci saranno solo le linee distinte, cioè, ci saranno solo le linee senza ripetizione .
come posso adattare questo macro del sr. patel per eseguire l'operazione per
eliminare le righe duplicate nel
foglio di lavoro 1 ?
abbracci amici .
Re: cancella Righe con valori duplicati
Inviato: sabato 2 marzo 2019, 8:30
da patel
i duplicati sono quale colonna ? ci sono righe vuote ? i duplicati sono consecutivi ? meglio allegare un file di esempio, comunque prova questa
Codice: Seleziona tutto
Sub Eliminadoppie
oSheet = ThisComponent.Sheets(0)
col=0 ' colonna A
RIGA=1
call OrdinaDati
CellaPrec =oSheet.getCellByPosition(col,RIGA - 1).string
Cella = oSheet.getCellByPosition(col,RIGA).string
Do
If StrComp(Cella, CellaPrec, 0) = 0 Then
oSheet.Rows.removeByIndex(RIGA, 1)
Cella = oSheet.getCellByPosition(col,RIGA).string
else
RIGA = RIGA + 1
CellaPrec = Cella
Cella = oSheet.getCellByPosition(col,RIGA).string
if Cella = "" then exit do
End If
Loop
End Sub
Sub OrdinaDati
dim I,lastCol as integer
Dim oSheetDSC As Object, oDSCRange As Object
Dim aSortFields(0) As New com.sun.star.util.SortField
Dim aSortDesc(0) As New com.sun.star.beans.PropertyValue
oSheet = ThisComponent.CurrentController.ActiveSheet
rng1= getUsedRange(oSheet)
LastRow = rng1.RangeAddress.EndRow
LastCol = rng1.RangeAddress.EndColumn
ordCol = 0
oDSCRange = oSheet.getCellRangeByPosition(0,1, lastCol,LastRow) ' range da ordinare
ThisComponent.getCurrentController.select(oDSCRange)
aSortFields(0).Field = ordCol
aSortFields(0).SortAscending = TRUE 'ordine crescente, se si vogliono i dati in ordine decrescente inserire FALSE
aSortDesc(0).Name = "SortFields"
aSortDesc(0).Value = aSortFields() ' aSortFields(0)
oDSCRange.Sort(aSortDesc()) ' aSortDesc(0)
End Sub
Function getUsedRange(oSheet)
Dim oRg
oRg = oSheet.createCursor()
oRg.gotoStartOfUsedArea(False)
oRg.gotoEndOfUsedArea(True)
getUsedRange = oRg
End Function
Re: cancella Righe con valori duplicati
Inviato: domenica 3 marzo 2019, 5:29
da chimico
sr. patel , la tua macro è molto buona, fa già molto bene la prima attività proposta, che consisteva nell'eliminare le righe con valori duplicati nella colonna "A" .
ma la necessità è più ampia, in quanto ho una colonna che deve visualizzare la somma accumulato dei valori .
solo dopo aver visualizzato la somma accumulato è possibile eliminare le righe con valori duplicati .
osservazione:
è necessario eseguire questa operazione del somma accumulato con macro .
nella colonna "A" ha una lista di lettere .
nella colonna "B" ha valori per ogni lettera .
nella colonna "C" ha la somma accumulato dei valori corrispondenti delle lettere (che devono essere fatte tramite macro) .
dopo la macro esegue la somma accumulato per ogni lettera della colonna "A", quindi la macro può eliminare le linee con valori duplicati nella colonna "A" .
Ho inserito un foglio di lavoro 2 con il modello del risultato finale che ho bisogno di raggiungere nel foglio di lavoro 1 .
così ho creato un file di esempio che è allegato .
Re: cancella Righe con valori duplicati
Inviato: domenica 3 marzo 2019, 9:48
da patel
Codice: Seleziona tutto
Sub EliminadoppieSomma
oSheet = ThisComponent.Sheets(0)
col=0 ' colonna A
RIGA=1
call OrdinaDati
CellaPrec =oSheet.getCellByPosition(col,RIGA - 1).string
Cella = oSheet.getCellByPosition(col,RIGA).string
ValorePrec=oSheet.getCellByPosition(1,RIGA - 1).Value
Valore = oSheet.getCellByPosition(1,RIGA).Value
Do
If StrComp(Cella, CellaPrec, 0) = 0 Then
Valore = valore+ValorePrec
oSheet.getCellByPosition(1,RIGA-1).Value = Valore
oSheet.Rows.removeByIndex(RIGA, 1)
Cella = oSheet.getCellByPosition(col,RIGA).string
ValorePrec=oSheet.getCellByPosition(1,RIGA - 1).Value
Valore=oSheet.getCellByPosition(1,RIGA).Value
else
RIGA = RIGA + 1
CellaPrec = Cella
Cella = oSheet.getCellByPosition(col,RIGA).string
ValorePrec=oSheet.getCellByPosition(1,RIGA - 1).Value
Valore = oSheet.getCellByPosition(1,RIGA).Value
if Cella = "" then exit do
End If
Loop
End Sub
Sub OrdinaDati
dim I,lastCol as integer
Dim oSheetDSC As Object, oDSCRange As Object
Dim aSortFields(0) As New com.sun.star.util.SortField
Dim aSortDesc(0) As New com.sun.star.beans.PropertyValue
oSheet = ThisComponent.CurrentController.ActiveSheet
rng1= getUsedRange(oSheet)
LastRow = rng1.RangeAddress.EndRow
LastCol = rng1.RangeAddress.EndColumn
ordCol = 0
oDSCRange = oSheet.getCellRangeByPosition(0,1, lastCol,LastRow) ' range da ordinare
ThisComponent.getCurrentController.select(oDSCRange)
aSortFields(0).Field = ordCol
aSortFields(0).SortAscending = FALSE 'ordine crescente, se si vogliono i dati in ordine decrescente inserire FALSE
aSortDesc(0).Name = "SortFields"
aSortDesc(0).Value = aSortFields() ' aSortFields(0)
oDSCRange.Sort(aSortDesc()) ' aSortDesc(0)
End Sub
Function getUsedRange(oSheet)
Dim oRg
oRg = oSheet.createCursor()
oRg.gotoStartOfUsedArea(False)
oRg.gotoEndOfUsedArea(True)
getUsedRange = oRg
End Function
Re: cancella Righe con valori duplicati
Inviato: domenica 3 marzo 2019, 14:44
da chimico
sr.
patel , La tua macro è stata fantastica .
segue il file allegato .
nel
foglio di lavoro 1 è l'architettura finale dell'operazione della tua macro .
nel
foglio di lavoro 2 è l'architettura finale che vorrei ottenere se possibile, cioè non modificare l'ordine iniziale dei valori, eliminare le righe con ripetizione
sotto le righe iniziali .
vedere la posizione di
x , y , z in foglio di lavoro 1 (la tua macro) , è stato ordinato
z , y , x .
vedere la posizione di
x , y , z nel foglio di lavoro 2 (desiderato) .
è possibile lasciare ordinato in x , y , z
?
Grazie mille, amico mio .
Re: cancella Righe con valori duplicati
Inviato: domenica 3 marzo 2019, 17:46
da patel
per eliminare le doppie è necessario fare un ordinamento alfabetico ascendente o discendente in modo da avere i valori uguali contigui
Edit:
Come non detto, se le righe non sono molte si può fare semplicemente così:
Codice: Seleziona tutto
Sub Elimina_doppie_NosortSum ' senza ordinamento
oSheet = ThisComponent.Sheets(0)
col=0 ' colonna A
RIGA=0: r = 1
Cella = oSheet.getCellByPosition(col,RIGA).string
Valore = oSheet.getCellByPosition(1,RIGA).Value
Do
Do
If StrComp(Cella, oSheet.getCellByPosition(col,r).string, 0) = 0 Then
Valore = Valore + oSheet.getCellByPosition(1,r).Value
oSheet.getCellByPosition(1,RIGA).Value= Valore
oSheet.Rows.removeByIndex(r, 1)
else
r=r+1
if oSheet.getCellByPosition(col,r).string = "" then exit do
End If
Loop
RIGA=RIGA+1
Cella = oSheet.getCellByPosition(col,RIGA).string
Valore = oSheet.getCellByPosition(1,RIGA).Value
r=RIGA+1
if Cella = "" then exit do
Loop
End Sub
Re: cancella Righe con valori duplicati
Inviato: domenica 3 marzo 2019, 21:41
da chimico
[
RISOLTO]
Grazie mille per il tuo aiuto, è stato perfetto .
Congratulazioni per la tua conoscenza .
abbraccia il mio amico .