[Risolto] Copia i valori con "x" con Limite colonna

[chimico]

Saluti ,

Ho una macro di sr. patel che copia da Foglio di lavoro 1 a Linea che contiene "x" e incolla su Foglio di lavoro 2, lo sta facendo correttamente .

ma ora è sorto un altro bisogno, poiché in Foglio di lavoro 1 ha anche valori nelle colonne "E", "F", "G" .

se guardi il Foglio di lavoro 2 puoi vedere come stai incollando i valori copiati da Foglio di lavoro 1, cioè stai copiando l'intera Linea che contiene "x" .

Ho bisogno che tu copi dal Foglio di lavoro 1 solo i valori delle colonne "A", "B" e "C" contenenti "x", quindi inserisci la data nella colonna successiva "D" .

Ho inserito un Foglio di lavoro 3 per mostrare il risultato che voglio raggiungere .

il file allegato .

[patel]

modifica così le prime righe della macro

Codice: Seleziona tutto

sub CopyVisiblex
oDoc = ThisComponent
sh= oDoc.Sheets.getByName("Plan1")
sh1= oDoc.Sheets.getByName("Plan2")
rng= getUsedRange(sh)
Lastcol = 2'<<<<
LastRow = rng.RangeAddress.EndRow '<<<<
rng = Sh.getCellRangeByPosition(0,1,Lastcol,LastRow)'<<<<
rng1= getUsedRange(sh1) 
LastRow1 = rng1.RangeAddress.EndRow 
oRanges = rng.queryVisibleCells()
oCell = sh1.getcellByPosition(0,LastRow1+1) 
call copyVisibleRows(oDoc, oRanges, oCell,LastRow)

[chimico]

sr. patel,

Se osservate nel foglio di lavoro 3 che ho inserito con il modello del risultato finale desiderato, potete vedere che nella colonna "E" ci sono altri valori .

Se osservi il risultato della macro nel foglio di lavoro 2, puoi vedere che stai incollando i risultati dopo i valori della colonna "E" .

Voglio ottenere il risultato come nell'esempio di foglio di lavoro 3 .

segue il nuovo file allegato .

amico abbraccio .

[patel]

vero, però dopo tutti i suggerimenti che hai avuto dovresti essere in grado di fare da solo queste piccole modifiche.
Nelle discussioni precedenti abbiamo visto come calcolare l'ultima cella occupata della colonna A con la sub ultima_cella

[chimico]

sì, è vero sr. patel .

così ho provato ad adattarmi con i tuoi ultimi suggerimenti, ma non ci sono riuscito .

Non ho davvero avuto successo .

osservazione :
premi il pulsante "copia ..." quindi nel foglio di lavoro 2 vedrai come sta avvenendo il trasferimento dei valori .

i miei cambiamenti di macro sono contrassegnati con il '+++++++++++++

segue il file allegato .

[patel]

Codice: Seleziona tutto

sub CopyVisiblex

oDoc = ThisComponent
sh= oDoc.Sheets.getByName("Plan1")
sh1= oDoc.Sheets.getByName("Plan2")
rng= getUsedRange(sh)
Lastcol = 2 '<<<<
LastRow = rng.RangeAddress.EndRow '<<<<
rng = Sh.getCellRangeByPosition(0,1,Lastcol,LastRow)'<<<<
rng1= getUsedRange(sh1) 
'LastRow1 = rng1.RangeAddress.EndRow 
Call ultima_cella
LastRow1 = oDoc.CurrentSelection.CellAddress.Row-1
   
 
oRanges = rng.queryVisibleCells()
oCell = sh1.getcellByPosition(0,LastRow1+1) 
call copyVisibleRows(oDoc, oRanges, oCell,LastRow)

sh1.Columns.OptimalWidth  = True
FOR r = LastRow to LastRow1+1 STEP -1 
  IF Sh1.getCellByPosition(1, r).String <> "x" THEN 
    Sh1.Rows.removeByIndex(r, 1)
  else ' <<<<
    sh1.getcellByPosition(Lastcol+1,r).String =  Date 
  end if
NEXT
end sub



Sub copyVisibleRows(oDoc,oRanges,oTopLeft,LastRow)
Dim oTargetSheet, oEnum, aTgt, oTgtRg, oNext, aNext, aPrev, iRow&, bCalc As Boolean
Dim oResult as New com.sun.star.table.CellRangeAddress
   bCalc = oDoc.isAutomaticCalculationEnabled()
   oDoc.enableAutomaticCalculation(False)
   aTgt = oTopLeft.getCellAddress()
   iRow = aTgt.Row
   oTargetSheet = oDoc.getSheets.getByIndex(aTgt.Sheet)
   oResult.Sheet = aTgt.Sheet
   oResult.StartColumn = aTgt.Column
   oResult.StartRow = aTgt.Row
   oEnum = oRanges.createEnumeration()
   while oEnum.hasMoreElements()
      oNext = oEnum.nextElement()
      aNext = oNext.getRangeAddress()
      if not isUnoStruct(aPrev) then aPrev = aNext
      If aNext.StartColumn > aPrev.StartColumn then
         aTgt.Column = aTgt.Column + aPrev.EndColumn - aPrev.StartColumn +1
         aTgt.Row = iRow
      elseIf aNext.StartRow > aPrev.StartRow then
         aTgt.Row = aTgt.Row + aPrev.EndRow - aPrev.StartRow +1
      endif
      oTgtRg = oTargetSheet.getCellRangeByPosition( _
         aTgt.Column, aTgt.Row, _
         aTgt.Column + aNext.EndColumn - aNext.StartColumn, _
         aTgt.Row + aNext.EndRow - aNext.StartRow)
      oTgtRg.setDataArray(oNext.getDataArray())
      aPrev = aNext
     LastRow=aTgt.Row
   wend
   oDoc.enableAutomaticCalculation(bCalc)  
End sub



Function getUsedRange(oSheet)
Dim oRg
   oRg = oSheet.createCursor()
   oRg.gotoStartOfUsedArea(False)
   oRg.gotoEndOfUsedArea(True)
   getUsedRange = oRg
End Function

sub ultima_cella
dim theDoc as object    
	 theDoc   = ThisComponent
	 theSheet = theDoc.Sheets.getByName("Plan2")
	 eCells   = theSheet.Columns(0).QueryEmptyCells
	 finRg    = eCells(eCells.Count - 1)
	 If finRg.RangeAddress.EndRow<>theSheet.RangeAddress.endRow Then Exit Sub
	 target   = finRg.GetCellByPosition(0, 0)
	 theDoc.CurrentController.Select(target)
end sub

[chimico]

[RISOLTO]

sr. patel , questo è quello che stavo cercando .

Grazie per l'attenzione e l'aiuto .

i tuoi macro sono davvero grandiosi .