[Risolto] Macro vba. Si può adattare?

[solitariopc]

Buongiorno...,
sulla rete ho trovato dopo varie ricerche questa macro scritta in visualbasic per excel, consapevole che non può funzionare in libreoffice per le ovvie ragioni che conosciamo mi rivolgo a Voi per poterla adattare se possibile, allego il file che ho trovato e che funziona in windows XP.

Codice: Seleziona tutto

Option VBASupport 1
    Public col(100), r, n, nr As Long, Col2() As Integer
    Function comb2(k)
    'Variante che lavora con Col2()
    col(k) = col(k - 1)
    While col(k) < n - r + k
        col(k) = col(k) + 1
        If k < r Then
            comb2 (k + 1)
        Else
            nr = nr + 1
            For i = 1 To r
                Col2(nr - 1, i - 1) = col(i)
                'Cells(nr, i) = col(i)
            Next
        End If
    Wend
    End Function


    Sub Anth()
    Col2H = Evaluate("FACT(B1)/FACT(B2)/FACT(B1-B2)")
    ReDim Col2(Col2H, [B2] - 0)
    'Ih = 1: Iv = 1
    Foglio1.Range("a4:EA" & Rows.Count).ClearContents
    nr = 0
    k = 1
    r = Cells(2, 2)
    n = Cells(1, 2)
    [g1] = Timer
    comb2 (k)
    Range("A4").Resize([M2], [B2]) = Col2
    [g2] = Timer
    ReDim Col2(1, 1)
    End Sub

Una breve spiegazione per capire ciò che fa questa macro: avendo una quantità di numeri (cella B1), in coppie di 2,3,4,5,6, (cella B2)..., le possibili combinazioni sono elencate nella cella M2. Chiedo se si può fare o se esiste un altro modo per ottenere lo stesso risultato. Questo quesito lo rivolgo a chi ha competenze nella scrittura delle macro. Allego File in xls per migliore comprensione.
Grazie a chi concede ascolto; saluti a Voi.

[patel]

allego il file modificato dove ho sostituito la riga
Range("A4").Resize([M2], [B2]) = Col2
con un ciclo for

[solitariopc]

Buonasera, chiedo scusa per il ritardo e rispondo ringraziando Patel per la risposta e il tempo dedicato. Ok, la macro modificata funziona ed è quello che chiedevo nella mia domanda. Se possibile e per favore non me ne voglia, sempre nel solco della domanda di aiuto antecedente ho trovato una macro sempre in vba che funziona allo stesso modo ma va oltre, riesce ad abbinare in combinazioni una tabella di nomi. crede sia possibile adattarla, scriverla in starbasic, le allego il codice e il file in .xls per una rapida visione. Ancora grazie e una buona giornata.

Codice: Seleziona tutto

Rem Attribute VBA_ModuleType=VBAModule
Option VBASupport 1
    Public col(100), r, n, nr As Long, Col2() As Variant

    Function comb2(k)
    'by Anthony47; Variante che lavora con Col2()
    col(k) = col(k - 1)
    While col(k) < n - r + k
        col(k) = col(k) + 1
        If k < r Then
            comb2 (k + 1)
        Else
            nr = nr + 1
            For I = 1 To r
                Col2(nr - 1, I - 1) = col(I)
                'Cells(nr, i) = col(i)
            Next
        End If
    Wend
    End Function


    Sub CombAnth()
    'by Anthony47
    Dim combArr(), I As Long, J As Long, curCalc
    Dim myCombList As String, myMembri As String, myGroup As String, myDest As String
    '
    'Se M1 e' vuoto si combinano numeri interi da 1 a N
    myCombList = "M2"               '<<< La cella dove comincia l' elenco delle voci da Combinare
    myMembri = "C3"                 '<<< La cella che contiene il numero di valori da combinare
    myGroup = "C4"                  '<<< La cella che contiene il numero di elementi per ogni gruppo
    myDest = "J6"                   '<<< La cella da dove sara' creato l' elenco combinatorio
    '
    curCalc = Application.Calculation
    Application.Calculation = xlManual
    '
    If Range(myCombList) <> "" Then
    ReDim combArr(1 To 101)
        For I = 0 To 100
            If Range(myCombList).Offset(0, I) <> "" Then
                combArr(I + 1) = Range(myCombList).Offset(0, I).Value
            Else
                ReDim Preserve combArr(1 To I)
                Exit For
            End If
        Next I
    End If

    col2h = Evaluate("FACT(" & myMembri & ")/FACT(" & myGroup & ")/FACT(" & myMembri & "-" & myGroup & ")")
    ReDim Col2(col2h, Range(myGroup) - 0)
    'Ih = 1: Iv = 1
    Range(myDest).Resize(Rows.Count - Range(myDest).Row - 1, 5).ClearContents   '<<<*** Vedi testo
    Range("I8:P8").Resize(Rows.Count - 9, 8).ClearContents
    nr = 0
    k = 1
    r = Range(myGroup)
    n = Range(myMembri)
    '[g1] = Timer
    comb2 (k)
    '
    If UBound(combArr, 1) < 100 Then
        For I = LBound(Col2, 1) To UBound(Col2, 1)
            For J = LBound(Col2, 2) To UBound(Col2, 2)
                If Not IsEmpty(Col2(I, J)) Then Col2(I, J) = combArr(Col2(I, J))
            Next J
        Next I
    End If
    Range("I7:P7").Resize(col2h + 2, 8).FillDown
    Range(myDest).Resize(col2h, Range(myGroup)) = Col2
    '[g2] = Timer
    ReDim Col2(1, 1)
    Application.Calculation = curCalc
    Calculate
    End Sub

P.s. domanda: perché il file che Lei ha modificato è in .xls e non in .ods?

[patel]

Se possibile e per favore non me ne voglia, sempre nel solco della domanda di aiuto antecedente ho trovato una macro sempre in vba che funziona allo stesso modo ma va oltre, riesce ad abbinare in combinazioni una tabella di nomi. crede sia possibile adattarla, scriverla in starbasic...

Troppo complicata, occorrerebbe farsela scrivere dall'autore popolando la tabella con un ciclo invece del metodo array to range.
Queste sono le righe che Starbasic non capisce

Codice: Seleziona tutto

    Range("I7:P7").Resize(col2h + 2, 8).FillDown
    Range(myDest).Resize(col2h, Range(myGroup)) = Col2

P.s. domanda: perché il file che Lei ha modificato è in .xls e non in .ods?

perché tu mi hai fornito un xls ed io ho modificato le righe incompatibili con starbasic

[solitariopc]

Patel, la sua risposta conferma i dubbi su quello che avevo pensato e cioè che bisognava mettere mano su molteplici righe se non tutte, la ringrazio ancora per la disponibilità nel rispondere.
Piccola riflessione: chi non utilizza il foglio xls. non potra utilizzare quella soluzione non crede.
Buonaserata e saluti.

[patel]

Piccola riflessione: chi non utilizza il foglio xls. non potra utilizzare quella soluzione non crede.

Non capisco la battuta, OO e LO possono aprire i file xls

[unlucky83]

Codice: Seleziona tutto

REM  *****  BASIC  *****
option explicit

Function CalculateFactorial( Number )
  If Number < 0 Or Number <> Int( Number ) Then
    CalculateFactorial = "Invalid number for factorial!"
  ElseIf Number = 0 Then
    CalculateFactorial = 1
  Else
    CalculateFactorial = Number * CalculateFactorial( Number - 1 )
  Endif
End Function

function combinazioni(membri as long,gruppo as long) as long
	combinazioni=CalculateFactorial( membri )/CalculateFactorial( gruppo )/CalculateFactorial( membri-gruppo )
end function


Sub CombAnth()
    dim osh as object
    Dim combArr(), I As Long, J As Long,m as long,z as long
    dim row as long, col as long, row2 as long,col2 as long,col2h as long,rowindex as long
    Dim myCombList As String, myMembri As String, myGroup As String, myDest As String
    dim nmembri as integer,ngruppi as integer
    dim indicirif()
    myCombList = "M2"               '<<< La cella dove comincia l' elenco delle voci da Combinare
    myMembri = "C3"                 '<<< La cella che contiene il numero di valori da combinare
    myGroup = "C4"                  '<<< La cella che contiene il numero di elementi per ogni gruppo
    myDest = "J6"                   '<<< La cella da dove sara' creato l' elenco combinatorio
	osh=thiscomponent.CurrentController.ActiveSheet
	row=osh.getcellrangebyname(mycomblist).getrangeaddress().StartRow    '
	col=osh.getcellrangebyname(mycomblist).getrangeaddress().StartColumn
	row2=osh.getcellrangebyname(myDest).getrangeaddress().StartRow    '
	col2=osh.getcellrangebyname(myDest).getrangeaddress().StartColumn
	nMembri=osh.getcellrangebyname( myMembri).value
	nGruppi=osh.getcellrangebyname(myGroup).value
    i=0
    do
    If osh.getcellbyposition(col+i,row).string = "" Then exit do
    	Redim Preserve combarr( 1 to i+1)
    	combArr(i + 1) = osh.getcellbyposition(col+i,row).string
    	i=i+1
    loop
    Redim indicirif(1 to nGruppi)
   	 	
    col2h=combinazioni(nmembri,ngruppi)
    osh.getcellrangebyposition(col2,row2,col2+ngruppi-1,10000).clearContents(7)
    for j=nGruppi to 1  step -1
 		for i= lbound( indicirif) to  ubound( indicirif)
    		indicirif(i)=i
		next
   		rowindex=row2
   		do
    	if rowindex=col2h+row2 then exit do
    		for m=indicirif(j) to nMembri -ngruppi+j
	   			z=combinazioni(nMembri-m,nGruppi-j)
	 			for i=0 to z-1
	  				osh.getcellbyposition(col2+j-1,rowindex+i).string=combarr(m)
	   			next
	   			rowindex=rowindex+i
	 	   	next
	 	   	indicirif=incremento(indicirif,j,nMembri -ngruppi+j)
	 	loop
    next
msgbox "fine"
End Sub

function incremento(indicirif as Variant, j as long,soglia as integer) as variant
 dim z as integer
	indicirif(j)=indicirif(j)+1
'	msgbox j & "#" & soglia  & "#" & indicirif(j)  & "#" &  ubound(indicirif)
	if indicirif(j)> soglia then
		indicirif=incremento(indicirif,j-1,soglia-1)
	else
		if j<ubound(indicirif) then
			for z=j+1 to ubound(indicirif)
				indicirif(z)=indicirif(z-1)+1
			next
		end if
	end if
	incremento=indicirif
end function

Ho rifatto le macro utilizzando due funzioni iterative. Ho controllato che funzionasse per membri=10 e gruppi=5. Avendo usato le funzioni iterate dovrebbe andar bene con qualsiasi altra coppia di numeri. Ovviamente il numero delle combinazioni non deve essere maggiore delle righe del foglio e la pulizia del foglio per adesso è impostata fino al rigo 10000

Codice: Seleziona tutto

osh.getcellrangebyposition(col2,row2,col2+ngruppi-1,10000).clearContents(7)

Visto che la macro l'ho fatta in openoffice basic, l'allegato è in formato ods.

[unlucky83]

Ho modificato un pò le macro precedenti per renderle più scattanti. La macro principale è Sub Comb()

Codice: Seleziona tutto

REM  *****  BASIC  *****
option explicit

Function CalculateFactorial( Number )
  If Number < 0 Or Number <> Int( Number ) Then
    CalculateFactorial = "Invalid number for factorial!"
  ElseIf Number = 0 Then
    CalculateFactorial = 1
  Else
    CalculateFactorial = Number * CalculateFactorial( Number - 1 )
  Endif
End Function

function combinazioni(membri as long,gruppo as long) as long
	combinazioni=CalculateFactorial( membri )/CalculateFactorial( gruppo )/CalculateFactorial( membri-gruppo )
end function

function incremento(indicirif as Variant, j as long,soglia as integer) as variant
 dim z as integer
 	indicirif(j)=indicirif(j)+1
'	msgbox j & "#" & soglia  & "#" & indicirif(j)  & "#" &  ubound(indicirif)
	if indicirif(j)> soglia  then
		if j=1 then
			exit function
		end if
		indicirif=incremento(indicirif,j-1,soglia-1)
	else
		if j<ubound(indicirif) then
			for z=j+1 to ubound(indicirif)
				indicirif(z)=indicirif(z-1)+1
			next
		end if
	end if
	incremento=indicirif
end function

Sub Comb()
	dim osh as object
    Dim combArr(), I As Long, J As Long,m as long,z as long
    dim row as long, col as long, row2 as long,col2 as long,col2h as long,rowindex as long
    Dim myCombList As String, myMembri As String, myGroup As String, myDest As String
    dim nmembri as integer,ngruppi as integer
    dim indicirif()
    myCombList = "M2"               '<<< La cella dove comincia l' elenco delle voci da Combinare
    myMembri = "C3"                 '<<< La cella che contiene il numero di valori da combinare
    myGroup = "C4"                  '<<< La cella che contiene il numero di elementi per ogni gruppo
    myDest = "J6"                   '<<< La cella da dove sara' creato l' elenco combinatorio
	osh=thiscomponent.CurrentController.ActiveSheet
	row=osh.getcellrangebyname(mycomblist).getrangeaddress().StartRow    '
	col=osh.getcellrangebyname(mycomblist).getrangeaddress().StartColumn
	row2=osh.getcellrangebyname(myDest).getrangeaddress().StartRow    '
	col2=osh.getcellrangebyname(myDest).getrangeaddress().StartColumn
	nMembri=osh.getcellrangebyname( myMembri).value
	nGruppi=osh.getcellrangebyname(myGroup).value
    i=0
    do
    If osh.getcellbyposition(col+i,row).string = "" Then exit do
    	Redim Preserve combarr( 1 to i+1)
    	combArr(i + 1) = osh.getcellbyposition(col+i,row).string
    	i=i+1
    loop
    Redim indicirif(1 to nGruppi)
   	for i= lbound( indicirif) to  ubound( indicirif)
    	indicirif(i)=i
	next
   	col2h=combinazioni(nmembri,ngruppi)
    osh.getcellrangebyposition(col2,row2,col2+ngruppi-1,10000).clearContents(7)
    rowindex=row2 		
   	i=0
   	do
    if rowindex+i=col2h+row2 then exit do
    	for j=1 to nGruppi
    		osh.getcellbyposition(col2+j-1,rowindex+i).string=combarr(indicirif(j))
	 	next
    	indicirif=incremento(indicirif,nGruppi,nMembri)
    	i=i+1
    loop
msgbox "fine"
End Sub

[solitariopc]

Salve, mi scuso per il ritardo non ho avuto molto tempo a disposizione e sono qui a spiegare l'affermazione di Patel. Signor Patel come lei mi fa notare un file .xls può essere aperto sia con Ooo, che con Liboo, e su questa affermazione taccio per giusta ragione, è vero, ma quello che volevo mettere in evidenza con quella semplice domanda era la possibilità di creare un file originale in .ods completamente creato con libreoffice o openoffice. Chiedo scusa se ho trasmesso un pensiero diverso da quello che volevo dire. Grazie lo stesso anche se non sono stato chiaro nell'esporre il problema.
Unlucky83 il file che Lei ha postato con la macro nuova creata con Basic l'ho provata e fà proprio quello che intendevo esprimere con la nota, Lei ha colto in pieno il senso della (piccola) riflessione, benfatto. Grazie, sembra che funzioni salvo che nel cambio di numero d'accopiate (cella C4)se invece di 5 metto 3 le colonne M ed N della tabella (la 4 e 5) restano scritte per intero non vengono cancellate. Ho risolto con una macro (sempre trovata nel forum) per pulire la tabella prima del ricalcolo; ho inserito una seconda macro per pulire gli elementi in gioco, allego file per conoscenza.
Un saluto a Voi per l'interessamento e l'aiuto. Una buona serata.

P.S. Solo ora ho letto la nuova formulazione per rendere più veloce il lavoro, la provo e le faccio sapere.

[unlucky83]

Vero

Codice: Seleziona tutto

 osh.getcellrangebyposition(col2,row2,col2+ngruppi-1,10000).clearContents(7)

qui la macro dice di pulire le colonne pari al numero indicato in C4. Se il numero massimo dei gruppi è 10 si può modificare in:

Codice: Seleziona tutto

 osh.getcellrangebyposition(col2,row2,col2+9,10000).clearContents(7)

, così risparmi un pulsante.
Oppure potresti richiamare la tua macro "Ripulisci_combi" nel codice di Sub CombAnth().

[solitariopc]

Salve unlucky83 buona giornata, ho testato le correzioni che hai scritto e devo dire che è tutto OK, metto risolto. Grazie ancora e Saluti.