[Risolto] cancella Righe con valori duplicati

[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 .

[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 

[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 .

[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

[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 .

[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

[chimico]

[RISOLTO]

Grazie mille per il tuo aiuto, è stato perfetto .
Congratulazioni per la tua conoscenza .

abbraccia il mio amico .