Estrapolare una sola ruota 2° capitolo

[Westham]

Buonasera. Apro un nuovo topic anche se il tema riguarda una piccola variante che mi servirebbe apportare a una macro che il bravissimo Gaetanopr mi aveva sviluppato qualche settimana fa concernente l’estrapolazione di una sola ruota. Si tratta in pratica di modificare ancora una volta le 6 estrazioni complete evidenziate a sinistra ma che in questo caso partirebbero dalla colonna I e non più dalla colonna A riducendo sempre il tutto a una sola ruota (nell’esempio Milano),tale e quale così come è visibile sulla parte destra del foglio con la sola estrazione di Milano che inizierebbe questa volta dalla colonna AC invece che dalla colonna I. Nella macro che è all’interno del file ho provato a sforzarmi nel raggiungere il risultato ma purtroppo non ci sono riuscito. Ci sono alcuni parametri da correggere. Mi scuso. Una buona serata

7 settembre una sola ruota.ods (11.9 KB)

[gaetanopr]

Prova in questo modo

Sub Combinazioni(Target)
Sh = Target.getSpreadsheet()
oCell() = Split(Target.AbsoluteName, ".")
oCellTarget = oCell(1)
If oCellTarget = "$AA$1" Then  
   Macro1(Sh, Target)
elseif oCellTarget = "$AK$1" Then
  Macro2(Sh, Target)
end if
End Sub 


Sub Macro1(Sh, Target)
    c = Sh.createCursor
	c.gotoEndOfUsedArea(false) 
	LastRow = c.RangeAddress.EndRow
	Ruota = Target.String
	Sh.getCellrangeByName("AC1:AH"+LastRow+1).ClearContents(1+4)      
	Inizio = 6                        
	ColIn = 0
	ColDest = 28                                                      
	For x = 2 To 12
	 if Sh.getCellByPosition(ColIn, x).String = Ruota Then
	   exit for
	 end if  
	Next x
    For i = 0 To 116 Step 29
      Sh.getCellByPosition(ColDest, i).String = Sh.getCellByPosition(ColIn, 0).String
      Arr = Sh.getCellrangeByPosition(ColIn, x, ColIn + 5, x).GetDataArray
	  Sh.getCellrangeByPosition(ColDest, i+2, ColDest + 5, i+2).SetDataArray(Arr)
    Next i

	
	
	For i = 16 To 92
		if Left(Sh.getCellByPosition(ColIn, i).String, 10) = "Estrazione" Then 
		   Sh.getCellByPosition(ColDest, Inizio).String = Sh.getCellByPosition(ColIn, i).String
		   Inizio = Inizio + 2
		elseif Sh.getCellByPosition(ColIn, i).String = Ruota Then
		   Arr = Sh.getCellrangeByPosition(ColIn, i, ColIn + 5, i).GetDataArray
		   Sh.getCellrangeByPosition(ColDest, Inizio, ColDest + 5, Inizio).SetDataArray(Arr)
		   Inizio = Inizio + 27
		End if
	   
	Next i

End sub

Macro2(Sh, Target)

End Sub

[Westham]

Va bene,grazie mille

[Westham]

Ciao di nuovo Gaetano,funziona grazie. Un ultima cosa per favore. Come posso far funzionare la tua macro in 2 intervalli diversi contemporaneamente ? Vorrei appunto che il tuo codice si rendesse operativo oltre che nel range AC1-AH125 anche nell’area AM1-AQ125. Ho inserito una 2a macro cambiando solo i parametri dell’intervallo (da AC1-AH ad AM1-AQ) ma poi non so cosa fare. Buona giornata

tabella.ods (45.4 KB)

[Westham]

In pratica,vorrei che le 2 macro lavorassero contemporaneamente in modo che azionando i 2 pulsanti (in AA1 e AK1,a seconda poi delle ruote che desidero) mi apparissero poi tutte e 2 gli intervalli : AC1-AH125 e AM1-AQ125. Ho provato a scrivere prima questo codice :

Sub Main(Target)
istruzioni codice
call Main1(Target)
End sub

Sub Main1(Target)
istruzioni codice
End sub

e dopo :

Sub Main1Main2

Call Main1
Call Main2

End Sub

ma entrambi non funzionano. Ti rimando il file aggiornato. Quello precedente non va bene,scusa

tabella 3.ods (41.3 KB)

[gaetanopr]

Ciao, esistono vari modi per fare quello che ti serve, io ad esempio scriverei una sola macro gestendo i vari range di origine e di destinazione.
Un’altra soluzione semplice è scrivere due macro (Macro1 e Macro2) con una terza macro, che deve essere quella associata all’evento modificato del foglio, richiami la prima e la seconda in questo modo.

Sub Combinazioni(Target)
Sh = Target.getSpreadsheet()
oCell() = Split(Target.AbsoluteName, ".")
oCellTarget = oCell(1)
If oCellTarget = "$AA$1" Then  
   Macro1(Sh, Target)
elseif oCellTarget = "$AK$1" Then
  Macro2(Sh, Target)
end if
End Sub 


Sub Macro1(Sh, Target)
    c = Sh.createCursor
	c.gotoEndOfUsedArea(false) 
	LastRow = c.RangeAddress.EndRow
	Ruota = Target.String
	Sh.getCellrangeByName("AC1:AH"+LastRow+1).ClearContents(1+4)      
	Inizio = 6                        
	ColIn = 0
	ColDest = 28                                                      
	For x = 2 To 12
	 if Sh.getCellByPosition(ColIn, x).String = Ruota Then
	   exit for
	 end if  
	Next x
    For i = 0 To 116 Step 29
      Sh.getCellByPosition(ColDest, i).String = Sh.getCellByPosition(ColIn, 0).String
      Arr = Sh.getCellrangeByPosition(ColIn, x, ColIn + 5, x).GetDataArray
	  Sh.getCellrangeByPosition(ColDest, i+2, ColDest + 5, i+2).SetDataArray(Arr)
    Next i

	
	
	For i = 16 To 92
		if Left(Sh.getCellByPosition(ColIn, i).String, 10) = "Estrazione" Then 
		   Sh.getCellByPosition(ColDest, Inizio).String = Sh.getCellByPosition(ColIn, i).String
		   Inizio = Inizio + 2
		elseif Sh.getCellByPosition(ColIn, i).String = Ruota Then
		   Arr = Sh.getCellrangeByPosition(ColIn, i, ColIn + 5, i).GetDataArray
		   Sh.getCellrangeByPosition(ColDest, Inizio, ColDest + 5, Inizio).SetDataArray(Arr)
		   Inizio = Inizio + 27
		End if
	   
	Next i

End sub

Sub Macro2(Sh, Target)
................
End sub

[Westham]

Carissimo Gaetano,capisco che la tua pazienza abbia un limite ma per favore dimmi soltanto perchè la riga AC-AH125 rimane vuota. Sto diventando matto. La macro è questa :

Sub Main2(Target)
Sh = Target.getSpreadsheet()
oCell() = Split(Target.AbsoluteName, “.”)
oCellTarget = oCell(1)

If oCellTarget = “$AA$1” Then
c = Sh.createCursor
c.gotoEndOfUsedArea(false)
LastRow = c.RangeAddress.EndRow
Ruota = Target.String
Sh.getCellrangeByName(“AC1:AH”+LastRow+1).ClearContents(1+4)
Inizio = 6
ColIn = 8
ColDest = 28
For x = 2 To 12
if Sh.getCellByPosition(ColIn, x).String = Ruota Then
exit for
end if
Next x
For i = 0 To 116 Step 29
Sh.getCellByPosition(ColDest, i).String = Sh.getCellByPosition(ColIn, 0).String
Arr = Sh.getCellrangeByPosition(ColIn, x, ColIn + 5, x).GetDataArray
Sh.getCellrangeByPosition(ColDest, i+2, ColDest + 5, i+2).SetDataArray(Arr)
Next i

For i = 96 To 172
	if Left(Sh.getCellByPosition(ColIn, i).String, 10) = "Estrazione" Then 
	   Sh.getCellByPosition(ColDest, Inizio).String = Sh.getCellByPosition(ColIn, i).String
	   Inizio = Inizio + 2
	elseif Sh.getCellByPosition(ColIn, i).String = Ruota Then
	   Arr = Sh.getCellrangeByPosition(ColIn, i, ColIn + 5, i).GetDataArray
	   Sh.getCellrangeByPosition(ColDest, Inizio, ColDest + 5, Inizio).SetDataArray(Arr)
	   Inizio = Inizio + 27
	End if
   
Next i

End if

End sub

Sembra tutto a posto,tutto in regola,ma quando eseguo la macro,l’unica riga a non comparire e a restare vuota è proprio la 125 e non capisco il motivo e quale sia il parametro da modificare. Ciao e scusami ancora

12 settembre.ods (13.2 KB)

[gaetanopr]

L’errore è subdolo, in quanto difficile da vedere, prova a posizionarti sulla cella I163 fai F2 e vedrai che la stringa non è “Bari” ma "Bari " cioè con alcuni spazi dopo, prova a toglierli e la macro per magia funziona, per ovviare a questo bisogna modificare la macro in questo modo, sono due le parti da modificare.
Dobbiamo usare la funzione Trim per togliere eventuali spazi dovuti da importazione dati.
Prima:

if Trim(Sh.getCellByPosition(ColIn, x).String) = Ruota Then

Seconda:

elseif Trim(Sh.getCellByPosition(ColIn, i).String) = Ruota Then

Saluti

[Westham]

Va bene,grazie