Ricerca dati in un archivio

[[e-mail]]

Ciao a tutti, devo fare una ricerca dati in un archivio, non è la ricerca il problema, ma la mole dei dati

Premetto che si tratta di Lotto, ho un archivio di 6 numeri dalla colonna E alla colonna J composto di 14000 righe quindi un archivio grande

ed alla colonne "A-B" degli ambi composti da 2 numeri e sono oltre 4000 righe.

ora dovrei scrorrere per ogni ambo tutto l'archivio e contare quante volte è comparso l'ambo.

questo già lo faccio con la seguente macro

Sub RicerceSenzaParametri()
Dim r, r1, r2, c, x, y, d, d1, d2, n, n1, RnA, rng, ris

'SetFG
set sh =worksheets(Activesheet.name)
Sh.Activate
Range("C2:C10000").ClearContents
sNo
eNo
r1 = Cells(Rows.Count, 1).End(xlUp).Row
r2 = Cells(Rows.Count, 5).End(xlUp).Row
RnA = Range("A2:B" & r1)
ReDim ris(1 To r1)
For x = 1 To UBound(RnA)
If x = 100 Then
r = r
End If
d1 = RnA(x - 1, 1)
d2 = RnA(x - 1, 2)
n1 = 0
For y = 2 To r2
Set rng = Range("E" & y & ":J" & y)
n = WorksheetFunction.CountIf(rng, d1) + WorksheetFunction.CountIf(rng, d2)
If n = 2 Then n1 = n1 + 1
Next y
ris(x) = n1
Next x
r = 2: c = 3
For x = 1 To UBound(ris)
Cells(r, c) = ris(x)
r = r + 1
Next x
'eSi
'sSi
End Sub

ho cercato di lavorare con le matrici in modo da impiegare meno tempo, ma anche cosi il tempo è considerevole, per la mole dei dati.

esiste qualche altro modo o metodo o funzione, insomma qualsiasi cosa di ricerca che possa diminuire il tempo di esecuzione.

posso anche allegare il file nel caso

Ciao By Sal (8-D

[Bruno Campanini]

Post by ***@gmail.com
Ciao a tutti, devo fare una ricerca dati in un archivio, non è la ricerca il
problema, ma la mole dei dati
Premetto che si tratta di Lotto, ho un archivio di 6 numeri dalla colonna E
alla colonna J composto di 14000 righe quindi un archivio grande
ed alla colonne "A-B" degli ambi composti da 2 numeri e sono oltre 4000 righe.
ora dovrei scrorrere per ogni ambo tutto l'archivio e contare quante volte è
comparso l'ambo.
questo già lo faccio con la seguente macro
Sub RicerceSenzaParametri()
Dim r, r1, r2, c, x, y, d, d1, d2, n, n1, RnA, rng, ris
'SetFG
set sh =worksheets(Activesheet.name)
Sh.Activate
Range("C2:C10000").ClearContents
sNo
eNo
r1 = Cells(Rows.Count, 1).End(xlUp).Row
r2 = Cells(Rows.Count, 5).End(xlUp).Row
RnA = Range("A2:B" & r1)
ReDim ris(1 To r1)
For x = 1 To UBound(RnA)
If x = 100 Then
r = r
End If
d1 = RnA(x - 1, 1)
d2 = RnA(x - 1, 2)
n1 = 0
For y = 2 To r2
Set rng = Range("E" & y & ":J" & y)
n = WorksheetFunction.CountIf(rng, d1) +
WorksheetFunction.CountIf(rng, d2) If n = 2 Then n1 = n1 + 1
Next y
ris(x) = n1
Next x
r = 2: c = 3
For x = 1 To UBound(ris)
Cells(r, c) = ris(x)
r = r + 1
Next x
'eSi
'sSi
End Sub
ho cercato di lavorare con le matrici in modo da impiegare meno tempo, ma
anche cosi il tempo è considerevole, per la mole dei dati.
esiste qualche altro modo o metodo o funzione, insomma qualsiasi cosa di
ricerca che possa diminuire il tempo di esecuzione.
posso anche allegare il file nel caso

Fallo! è la cosa migliore.
E dimmi se ho capito bene:
- ad ogni ambo di A:B occorre precisare il numero di apparizioni
nelle 14000 sestine che si trovano in E:J

Bruno

[[e-mail]]

P.S. mi sono accorto di un errore

d1 = RnA(x - 1, 1)
d2 = RnA(x - 1, 2)

è da intendersi

d1 = RnA(x, 1)
d2 = RnA(x, 2)

esi-eno, ssi-sno sono commentate sono macro i Application.screenUpdating-enableevents-false-true

Bye bye

[[e-mail]]

Ciao si infatti ogni ambo deve contare quante apparizioni
nella cartella che allego il link, già ci sono i valori ma lanciando la macro ci vuole un sacco di tempo
http://www.filedropper.com/ricercaambi

Ciao e grazie per ogni suggerimento che potete darmi By Sal (8-D

[Bruno Campanini]

Post by ***@gmail.com
Ciao si infatti ogni ambo deve contare quante apparizioni
nella cartella che allego il link, già ci sono i valori ma lanciando la macro
ci vuole un sacco di tempo http://www.filedropper.com/ricercaambi
Ciao e grazie per ogni suggerimento che potete darmi By Sal (8-D

Non sono disposto a compilare alcun dato per il download.
Se ti va puoi inviarmelo per e-mail a: ***@libero.it

Bruno

[Ammammata]

Il giorno Thu 29 Oct 2020 04:02:06p, *Bruno Campanini* ha inviato su

Post by Bruno Campanini
Non sono disposto a compilare alcun dato per il download.

a me ha chiesto un codice di 4 cifre scritto sopra la casella di input,
tipo A94P, un captcha

[Bruno Campanini]

Post by Ammammata
Il giorno Thu 29 Oct 2020 04:02:06p, *Bruno Campanini* ha inviato su

Post by Bruno Campanini
Non sono disposto a compilare alcun dato per il download.

a me ha chiesto un codice di 4 cifre scritto sopra la casella di input,
tipo A94P, un captcha

Ora anche a me e ho scaricato il file.
La prima volta però mi ha chiesto 6 dati personali.
Forse avevo sbagliato il tasto downlosd...

Bruno

[[e-mail]]

Ciao non si potrebbe usare il filtro avanzato con il VBA, e filtrare solo i record che hanno l'ambo e contarli, passando al successivo ambo.

però purtroppo non so usare il filtro avanzato con il VBA

Ciao By Sal (8-D

[Bruno Campanini]

Post by ***@gmail.com
Ciao non si potrebbe usare il filtro avanzato con il VBA, e filtrare solo i
record che hanno l'ambo e contarli, passando al successivo ambo.
però purtroppo non so usare il filtro avanzato con il VBA
Ciao By Sal (8-D

Che cosa sarebbe il filtro avanzato?
Il mio codice, notevolmente diverso dal tuo (che non ho potuto testare
per la mancanza della macro SetFG) impiega 44 minuti circa a
determinare
le frequenze di 4014 ambi su 11837 sestine (non arrivo all'ultima
12583° perché alla 11837° manca il primo numero).
In molte altre manca il 6° numero, ma questo non mi disturba avendo
assunto a riferimento la prima colonna.
Comunque non ha senso far delle ricerche precise su un complesso di
dati
(sestine) non coerenti.

Col tuo programma quanto tempo impieghi?
È possibile avere tutte le sestine formate da sei numeri?

Bruno

[[e-mail]]

Post by ***@gmail.com
Ciao non si potrebbe usare il filtro avanzato con il VBA, e filtrare solo i
record che hanno l'ambo e contarli, passando al successivo ambo.
però purtroppo non so usare il filtro avanzato con il VBA

Ciao Bruno, purtroppo quelle estrazioni partono dal 1871, dove manca il 1° numero è un anomalia e va inserito il numero si può aggiungere un numero da 1 a 90 a piacere tanto per completare,

ma le sestine a volte mancano di numeri in quanto in date precedenti non era prevista la sestina adesso i numero sono 8 con Jolly e Stella

la mia elaborazione arriva a circa 2 ore ecco perche cercavo un altro metodo, comunque 44 minuti già è un bel traguardo.

il filtro avanzato ho visto che può essere usato su più colonne in contemporanea.

con il filtro normale non puoi vedere se ce un ambo 2 numeri nell'estrazione, in quanto non hanno una posizione fissa

con il filtro avanzato si può determinare con i criteri se nelle 6 colonne sono presenti i 2 numeri.
per cui usando il filtro avanzato e filtrando l'ambo, i 2 numeri, con i criteri avrai soltanto i record che soddisfano il criterio, la presenza dei due numeri nelle colonne.
a questo punto contando le colonne filtrate si avranno gli ambi, senza fare cicli od altro ma soltanto un ciclo per cambiare gli ambi.

una cosa del genere

Sub FAvanz()
Dim r, c, x, d

Range("archivio").AdvancedFilter Action:=xlFilterInPlace, _
CriteriaRange:=Range("M1:N1"), Unique:=True
'Range("Archivio").AdvancedFilter Action:=xlFilterInPlace, Range("M1:N1")',,Unique:=True

End Sub

dove in M1-N1 inserisco i 2 numeri

ma come ho detto non so usarlo e ci sto battendo la testa, al posto di "Action:=xlFilterInPlace" potrei usare "Action:=xlFilterCopy" per copiare i dati in altra posizione

ecco perche ho avanzato l'ipotesi del filtro avanzato

la macro SetFG

Sub SetFG()
Dim d
d = ActiveSheet.Name
Set Sh = Worksheets(d)
Set sh1 = Worksheets("ArchivioDal1871")
Set sh2 = Worksheets("Eventi")
Set Sh3 = Worksheets("Ricerche")
Set sh4 = Worksheets("Passi")
Set Sh5 = Worksheets("Appo")
Set Sh6 = Worksheets("RicercheSenzaparametri&date")
End Sub

mi serve unicamente per non dichiarare in ogni macro i fogli che mi servono, richiamandola ho tutti i fogli disponibili visto che sono pubbliche Sh...


se mi fai sapere la la macro che hai sviluppato

per il momento un Saluto e grazie per l'impegno
Ciao By Sal (8-D

[Bruno Campanini]

Post by ***@gmail.com
Ciao Bruno, purtroppo quelle estrazioni partono dal 1871, dove manca il 1°
numero è un anomalia e va inserito il numero si può aggiungere un numero da 1
a 90 a piacere tanto per completare,
ma le sestine a volte mancano di numeri in quanto in date precedenti non era
prevista la sestina adesso i numero sono 8 con Jolly e Stella
la mia elaborazione arriva a circa 2 ore ecco perche cercavo un altro metodo,
comunque 44 minuti già è un bel traguardo.
il filtro avanzato ho visto che può essere usato su più colonne in contemporanea.
con il filtro normale non puoi vedere se ce un ambo 2 numeri nell'estrazione,
in quanto non hanno una posizione fissa
con il filtro avanzato si può determinare con i criteri se nelle 6 colonne
sono presenti i 2 numeri. per cui usando il filtro avanzato e filtrando
l'ambo, i 2 numeri, con i criteri avrai soltanto i record che soddisfano il
criterio, la presenza dei due numeri nelle colonne. a questo punto contando
le colonne filtrate si avranno gli ambi, senza fare cicli od altro ma
soltanto un ciclo per cambiare gli ambi.
una cosa del genere
Sub FAvanz()
Dim r, c, x, d
Range("archivio").AdvancedFilter Action:=xlFilterInPlace, _
CriteriaRange:=Range("M1:N1"), Unique:=True
'Range("Archivio").AdvancedFilter Action:=xlFilterInPlace,
Range("M1:N1")',,Unique:=True
End Sub
dove in M1-N1 inserisco i 2 numeri
ma come ho detto non so usarlo e ci sto battendo la testa, al posto di
"Action:=xlFilterInPlace" potrei usare "Action:=xlFilterCopy" per copiare i
dati in altra posizione
ecco perche ho avanzato l'ipotesi del filtro avanzato

Io nemmeno sapevo che esistesse.
Comunque l'ho cercato, ho provato a farlo funzionare ma non ci sono
riuscito.
Se c'è qualcuno che lo sa spiegare bene... lo ringraziamo.

Questo è il mio codice:
==================================================
Public Sub Ambi_1()
Dim Ambi As Range, Sestine As Range, i, j, k As Long, m As Long
Dim n As Long, p As Long, S1 As String, T As Single, dup As Long

T = Timer

'Application.Calculation = xlCalculationManual
'Application.ScreenUpdating = False
Set Ambi = Range([A2], [A2].End(xlDown))
Set Sestine = Range([F2], [F2].End(xlDown))

[K:L].ClearContents
For Each i In Ambi
p = 0
For Each j In Sestine
S1 = vbNullString
For k = 0 To 5
S1 = S1 & j(1, k) & " "
Next
For k = 0 To 5
If i(1, 1) = j(1, k) Then
m = m + 1
Exit For
Else
m = 0
End If
Next

If m = 1 Then
For k = 0 To 5
If i(1, 2) = j(1, k) Then
n = n + 1
If m + n = 2 Then
Range(j(1, 0), j(1, 5)).Select
p = p + 1
i(1, 11) = p
If Not IsEmpty(j(1, 7)) Then
dup = dup + 1
End If
j(1, 7) = i(1, 1) & " " & i(1, 2)
MsgBox p & vbCrLf & i(1, 1) & " " & i(1, 2) &
vbCrLf & vbLf & S1
m = 0: n = 0
End If
End If
Next
End If
Next
Next
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
MsgBox Timer - T
MsgBox "Duplicati = " & dup

End Sub
===============================================

Per arrivare fino in fondo alle sestine ho considerato la loro seconda
colonna anziché la prima.
Per vederlo funzionare togli un ambo qualunque, diciamo il 32° ed
esegui la procedura.

Per ottenere i risultati senza il MsgBox, togli i REM alle prime due
Application... e mettine uno davanti al MsgBox.
Cià fatto reinserisci il 32° ambo e in 44 minuti dovresti avere
tutti i risultati.

La somma delle frequenze in colonna K potrebbe essere superiore
al numero totale degli ambi che appaiono in colonna L.
Ciò perché una sestina può accogliere 15 ambi (una cinquina 10)
e io non mi sono preoccupato di listarli tutti.

Le frequanze che appaiono in colonna K differiscono in parte dalle
tue di colonna C.
Ho controllato quelle generate dai soli primi 5 ambi e mi sembrano
corrette le mie...

Bruno

[Ammammata]

Post by ***@gmail.com
nella cartella che allego il link, già ci sono i valori ma lanciando
la macro ci vuole un sacco di tempo
http://www.filedropper.com/ricercaambi

una ricerca di due soli valori fatta con una formula è pressoché
immediata, da k2 fino in fondo:

=AND(OR(E2=$A$2;F2=$A$2;G2=$A$2;H2=$A$2;I2=$A$2;J2=$A$2);OR(E2=$B$2;F2=$B$2
;G2=$B$2;H2=$B$2;I2=$B$2;J2=$B$2)) copiata fino in fondo

in K1 c'è =COUNTIF(K2:K12584;TRUE) e dice 87, che quadra con l'altro totale

se ti interessa fare una ricerca ogni tanto senza avere tutta la tabella
degli ambi (li inserisci di volta in volta in a2 e b2) può essere un'idea

[Ammammata]

Post by ***@gmail.com
Premetto che si tratta di Lotto, ho un archivio di 6 numeri dalla
colonna E alla colonna J composto di 14000 righe quindi un archivio
grande

Lotto e "6 numeri" non sono in contraddizione?

se guardo qui:
https://www.franknet.altervista.org/lotto/page.php

le estrazioni sono da sempre 5 soli numeri

inoltre teoricamente ci sono 90*89/2 = 4005 diversi ambi

come mai tu hai 4014 righe?

[Bruno Campanini]

Post by Ammammata

Post by ***@gmail.com
Premetto che si tratta di Lotto, ho un archivio di 6 numeri dalla
colonna E alla colonna J composto di 14000 righe quindi un archivio
grande

Lotto e "6 numeri" non sono in contraddizione?
https://www.franknet.altervista.org/lotto/page.php
le estrazioni sono da sempre 5 soli numeri
inoltre teoricamente ci sono 90*89/2 = 4005 diversi ambi

Esatto, però i 4005 sono tutti quelli ottenibili dai 90 numeri.
Ad ogni estrazione però non ne appaiono più di 110, posto che ogni
cinquina non ne può generare più di 10 (5*4/2) e le ruote sono 11.
Se sono sestine ne appariranno 6*5/2=15 per sestina, da moltiplicare
poi per il numero delle ruote.

Post by Ammammata
come mai tu hai 4014 righe?

Ci sarà qualche doppione.

Bruno

[casanmaner]

Io ho provato sfruttando il filtro automatico.
Vedi questo file:
https://www.dropbox.com/s/1vvzmn4zbk5tzjr/Ricerca%20Ambi%202.xlsm?dl=0

Ho inserito la prima tabella con le coppie di ambi (e una colonna destinata all'inserimento del numero di ambi presenti).
La seconda tabella è quella delle estrazioni da analizzare.
Alla fine di questa tabella ho inserito una formula subtotale per contare i valori filtrati.

Con la macro presente nel modulo2 mi pare di aver ottenuto i tuoi stessi risultati anche se ci sono voluti con il mio pc 31 abbondanti.
La procedura esegue un ciclo per tutti gli ambi presenti nella tabella1 e applica in modo ciclico i filtri alle colonne della tabella delle estrazioni, legge il subtotale conta valori e lo somma fino a completare i filtri per tutte le colonne.


Questa la procedura:


Sub RicercaSenzaParametriNew()
Dim oLo1 As ListObject
Dim oLo2 As ListObject
Dim i As Long, j As Long, t As Long
Dim v1 As Long, v2 As Long
Dim contaAmbi As Long

Dim dTimer As Double

dTimer = Timer

With ThisWorkbook
With .Worksheets("RicercheSenzaparametri&date")
Set oLo1 = .ListObjects("Tabella1")
Set oLo2 = .ListObjects("Tabella2")
End With
End With
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With

For i = 1 To oLo1.ListRows.Count
v1 = oLo1.ListColumns("I").DataBodyRange(i).Value
v2 = oLo1.ListColumns("II").DataBodyRange(i).Value

For j = 1 To oLo2.ListColumns.Count - 1
oLo2.Range.AutoFilter Field:=j, Criteria1:="=" & v1
For t = j + 1 To oLo2.ListColumns.Count
oLo2.Range.AutoFilter Field:=t, Criteria1:="=" & v2
With oLo2.ListColumns("I").Total.Cells(1)
.Calculate
contaAmbi = contaAmbi + .Value
End With
oLo2.Range.AutoFilter Field:=t
Next t
oLo2.Range.AutoFilter Field:=j
Next j
oLo1.ListColumns("N.R.").DataBodyRange(i).Value = contaAmbi
contaAmbi = 0
Next i
With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
.EnableEvents = True
End With

Debug.Print Timer - dTimer
End Sub

Vorrei vedere con il filtro avanzato se si riesce ad ottenere qualcosa di fattibile e più veloce.

Altrimenti pensare ad una procedura che lavori in memoria.

[casanmaner]

Ho provato anche con il filtro avanzato ma è più lento (sui primi venti ambo circa 3" in più.
Comunque metto il secondo file per tue prove se vorrai:
https://www.dropbox.com/s/bjj5bff44dfeid9/Ricerca%20Ambi%202B.xlsm?dl=0

In questo file ci sono anche le tabelle3 e 4 dove nella 3 vengono inseriti i parametri e nella tabella 4 i valori da ricercare.
Per sfruttare il filtro avanzato nella tabella 3 nella riga dei dati inserisco gli ambi presi da ogni riga della tabella1.
Poi eseguo dei cicli andando a prendere i valori presenti nelle varie colonne della tabella 2 per portarli nella tabella 4 dove applicare il filtro.
La formula del totale conta il numero di valori filtrati e li somma fino a fine cicli per poi riportarli nella tabella1.


Questo il codice presente nel module3:


SSub RicercaSenzaParametriFiltroAvanzato()
Dim oLo1 As ListObject
Dim oLo2 As ListObject
Dim oLo3 As ListObject
Dim oLo4 As ListObject

Dim i As Long, j As Long, t As Long
Dim contaAmbi As Long

Dim dTimer As Double

dTimer = Timer
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With

With ThisWorkbook
With .Worksheets("RicercheSenzaparametri&date")
Set oLo1 = .ListObjects("Tabella1")
Set oLo2 = .ListObjects("Tabella2")
Set oLo3 = .ListObjects("Tabella3")
Set oLo4 = .ListObjects("Tabella4")
End With
End With
oLo3.DataBodyRange(oLo3.ListRows.Count).Offset(1).Select
For i = 1 To 20 'oLo1.ListRows.Count
oLo3.DataBodyRange(1, 1).Resize(1, 2).Value = oLo1.DataBodyRange(i, 1).Resize(1, 2).Value
For j = 1 To oLo2.ListColumns.Count - 1
oLo3.ListColumns(1).Name = j
With oLo4
.ListColumns(1).Name = j 'oLo2.ListColumns(j).Name
.ListColumns(1).DataBodyRange.Value = oLo2.ListColumns(j).DataBodyRange.Value
End With
For t = j + 1 To oLo2.ListColumns.Count
oLo3.ListColumns(2).Name = t
With oLo4
.ListColumns(2).Name = t 'oLo2.ListColumns(t).Name
.ListColumns(2).DataBodyRange.Value = oLo2.ListColumns(t).DataBodyRange.Value
.ShowTotals = False
.Range.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=oLo3.Range, unique:=False
.ShowTotals = True
With .ListColumns(1).Total.Cells(1)
.Calculate
contaAmbi = contaAmbi + .Value
End With
.Parent.ShowAllData
End With
Next t
Next j
oLo1.ListColumns("N.R.").DataBodyRange(i).Value = contaAmbi
contaAmbi = 0
Next i

With oLo3
.HeaderRowRange.ClearContents
.DataBodyRange.ClearContents
End With
With oLo4
.HeaderRowRange.ClearContents
.DataBodyRange.ClearContents
End With

With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
.EnableEvents = True
End With



Debug.Print Timer - dTimer
MsgBox "Filtro avanzato secondi = " & Timer - dTimer

End Sub

[casanmaner]

E alla fine ho voluto provare a lavorare con le matrici "in memoria" e ho ottenuto l'elaborazione di tutte gli ambi in 20"
Qui il nuovo file con anche la nuova procedura:
https://www.dropbox.com/s/jnve00no74zaern/Ricerca%20Ambi%202C.xlsm?dl=0

Questa la procedura, sempre legata alle tabelle per intercettare i valori e riportare i risultati, con l'uso delle matrici e cicli che leggono i valori presenti nelle stesse:

Nel modulo4


Sub RicercaSenzaParametriMatrici()

Dim oLo1 As ListObject
Dim oLo2 As ListObject
Dim ArrAmbi As Variant
Dim arrEstrazioni As Variant
Dim i As Long, j As Long, t As Long, y As Long
Dim contaAmbi As Long
Dim v1 As Long
Dim v2 As Long
Dim v3 As Long
Dim v4 As Long

Dim dTimer As Double

dTimer = Timer

With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With

With ThisWorkbook
With .Worksheets("RicercheSenzaparametri&date")
Set oLo1 = .ListObjects("Tabella1")
Set oLo2 = .ListObjects("Tabella2")
End With
End With

ArrAmbi = oLo1.DataBodyRange.Value
arrEstrazioni = oLo2.DataBodyRange.Value

For i = 1 To UBound(ArrAmbi, 1)
v1 = ArrAmbi(i, 1)
v2 = ArrAmbi(i, 2)
For t = 1 To UBound(arrEstrazioni, 2) - 1
For j = 1 To UBound(arrEstrazioni, 1)
v3 = arrEstrazioni(j, t)
If v3 = v1 Then
For y = t + 1 To UBound(arrEstrazioni, 2)
v4 = arrEstrazioni(j, y)
If v4 = v2 Then
contaAmbi = contaAmbi + 1
End If
Next y
End If
Next j
Next t
ArrAmbi(i, 3) = contaAmbi
contaAmbi = 0
Next i
oLo1.DataBodyRange.Value = ArrAmbi

With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
.EnableEvents = True
End With

Debug.Print Timer - dTimer
MsgBox "Filtro avanzato secondi = " & Timer - dTimer
End Sub

[Bruno Campanini]

Post by casanmaner
E alla fine ho voluto provare a lavorare con le matrici "in memoria" e ho
ottenuto l'elaborazione di tutte gli ambi in 20" Qui il nuovo file con anche
https://www.dropbox.com/s/jnve00no74zaern/Ricerca%20Ambi%202C.xlsm?dl=0
Questa la procedura, sempre legata alle tabelle per intercettare i valori e
riportare i risultati, con l'uso delle matrici e cicli che leggono i valori
Nel modulo4
Sub RicercaSenzaParametriMatrici()
Dim oLo1 As ListObject
Dim oLo2 As ListObject
Dim ArrAmbi As Variant
Dim arrEstrazioni As Variant
Dim i As Long, j As Long, t As Long, y As Long
Dim contaAmbi As Long
Dim v1 As Long
Dim v2 As Long
Dim v3 As Long
Dim v4 As Long
Dim dTimer As Double
dTimer = Timer
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With
With ThisWorkbook
With .Worksheets("RicercheSenzaparametri&date")
Set oLo1 = .ListObjects("Tabella1")
Set oLo2 = .ListObjects("Tabella2")
End With
End With
ArrAmbi = oLo1.DataBodyRange.Value
arrEstrazioni = oLo2.DataBodyRange.Value
For i = 1 To UBound(ArrAmbi, 1)
v1 = ArrAmbi(i, 1)
v2 = ArrAmbi(i, 2)
For t = 1 To UBound(arrEstrazioni, 2) - 1
For j = 1 To UBound(arrEstrazioni, 1)
v3 = arrEstrazioni(j, t)
If v3 = v1 Then
For y = t + 1 To UBound(arrEstrazioni, 2)
v4 = arrEstrazioni(j, y)
If v4 = v2 Then
contaAmbi = contaAmbi + 1
End If
Next y
End If
Next j
Next t
ArrAmbi(i, 3) = contaAmbi
contaAmbi = 0
Next i
oLo1.DataBodyRange.Value = ArrAmbi
With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
.EnableEvents = True
End With
Debug.Print Timer - dTimer
MsgBox "Filtro avanzato secondi = " & Timer - dTimer
End Sub

Sei stato bravissimo... complimenti.
La procedura con le matrici qui da me impiega 13 secondi!

Il tuo file coi 4005 ambi, da novanta numeri più di tanti
non se ne traggono:

https://1drv.ms/x/s!AvTaMfd5-b2oz0xk3FoNlIFIcJlP?e=rvY4XE

Bruno

[casanmaner]

Post by Bruno Campanini
La procedura con le matrici qui da me impiega 13 secondi!

Devo comprare un pc nuovo allora!!! :D

[Bruno Campanini]

Post by Bruno Campanini
Sei stato bravissimo... complimenti.
La procedura con le matrici qui da me impiega 13 secondi!
Il tuo file coi 4005 ambi, da novanta numeri più di tanti
https://1drv.ms/x/s!AvTaMfd5-b2oz0xk3FoNlIFIcJlP?e=rvY4XE

Ho sbagliato la copiatura dei 4005 ambi, qui la correzione:

https://1drv.ms/x/s!AvTaMfd5-b2oz0xk3FoNlIFIcJlP?e=RVhygx

Ed inoltre sto facendo esperimenti sul tuo codice e vorrei modificare
le dimensioni di Tabella1 (Ambi) e Tabella2 (Estrazioni) ma la
procedura non me lo consente (Formula->Name Manager...), perché?

Bruno

[casanmaner]

Post by Bruno Campanini

Post by Bruno Campanini
Sei stato bravissimo... complimenti.
La procedura con le matrici qui da me impiega 13 secondi!
Il tuo file coi 4005 ambi, da novanta numeri più di tanti
https://1drv.ms/x/s!AvTaMfd5-b2oz0xk3FoNlIFIcJlP?e=rvY4XE

https://1drv.ms/x/s!AvTaMfd5-b2oz0xk3FoNlIFIcJlP?e=RVhygx
Ed inoltre sto facendo esperimenti sul tuo codice e vorrei modificare
le dimensioni di Tabella1 (Ambi) e Tabella2 (Estrazioni) ma la
procedura non me lo consente (Formula->Name Manager...), perché?

Come effettui le dimensioni?
Normalmente basta selezionare l'angolo in basso a destra della tabella e trascinare verso il basso.
Volendo anche inserendo dei valori sotto la prima riga successiva e la tabella si ridimensiona automaticamente (eventualmente eliminando la riga dei totali).

[casanmaner]

Post by Bruno Campanini
procedura non me lo consente (Formula->Name Manager...), perché?

Forse ho capito.
I nomi delle tabelle e i riferimenti non possono essere modificati da Formula->Gestione nomi.

Devi andare nella tab "Progettazione" che appare quando selezioni una tabella.

ciao

[Bruno Campanini]

Post by casanmaner

Post by Bruno Campanini
procedura non me lo consente (Formula->Name Manager...), perché?

Forse ho capito.
I nomi delle tabelle e i riferimenti non possono essere modificati da
Formula->Gestione nomi.
Devi andare nella tab "Progettazione" che appare quando selezioni una tabella.
ciao

Quando seleziono una tabella, nel mio Excel 2019 ENG non appare
(non vedo) alcuna Progettazione o Project.
Io non uso mai le tabelle, uso solo range.

Bruno

[casanmaner]

Post by Bruno Campanini
Quando seleziono una tabella, nel mio Excel 2019 ENG non appare
(non vedo) alcuna Progettazione o Project.
Io non uso mai le tabelle, uso solo range.

Io ho questa tab "Progettazione"
Loading Image...

Non è che nella "personalizzazione" delle barre quella tab risulta deselezionata alla visualizzazione?

ciao

Post by Bruno Campanini
Bruno

[[e-mail]]

Post by casanmaner

Post by Bruno Campanini
Quando seleziono una tabella, nel mio Excel 2019 ENG non appare
(non vedo) alcuna Progettazione o Project.
Io non uso mai le tabelle, uso solo range.

Io ho questa tab "Progettazione"
https://www.dropbox.com/s/v3ra5qcmo5xqtxb/Screenshot%202020-11-01%2019.55.06.png?dl=0
Non è che nella "personalizzazione" delle barre quella tab risulta deselezionata alla visualizzazione?
ciao

Post by Bruno Campanini
Bruno

Ciao non credo che sia deselezionata è automatico quando si crea una tabella, questa e la mia schermata do Office2019 ita

Loading Image...

Ciao By Sal

[Bruno Campanini]

Post by ***@gmail.com

Post by casanmaner

Post by Bruno Campanini
Quando seleziono una tabella, nel mio Excel 2019 ENG non appare
(non vedo) alcuna Progettazione o Project.
Io non uso mai le tabelle, uso solo range.

Io ho questa tab "Progettazione"
https://www.dropbox.com/s/v3ra5qcmo5xqtxb/Screenshot%202020-11-01%2019.55.06.png?dl=0
Non è che nella "personalizzazione" delle barre quella tab risulta
deselezionata alla visualizzazione?
ciao

Post by Bruno Campanini
Bruno

Ciao non credo che sia deselezionata è automatico quando si crea una
tabella.

Penso tu abbia ragione, infatti tutte le Options del Ribbon
sono selezionate e non comprendono la progettazione.

Però io mi riferisco a una tabella creata nel file che sto usando
(quello di casanmaner)...

Fine del problema comunque, poiché io le tabelle non le uso.

Bruno

[casanmaner]

Post by Bruno Campanini

Post by ***@gmail.com
Ciao non credo che sia deselezionata è automatico quando si crea una
tabella.

Penso tu abbia ragione, infatti tutte le Options del Ribbon
sono selezionate e non comprendono la progettazione.
Però io mi riferisco a una tabella creata nel file che sto usando
(quello di casanmaner)...
Fine del problema comunque, poiché io le tabelle non le uso.
Bruno

Ma tu selezioni una cella all'interno della tabella?

Comunque Bruno le tabelle sono una delle cose più comode da utilizzare in vba.
Non devi più preoccuparti di riferimenti che in vba risultano statici :)
Per me l'invenzione migliore da Excel 2007 :)

[Bruno Campanini]

Post by casanmaner

Post by Bruno Campanini

Post by ***@gmail.com
Ciao non credo che sia deselezionata è automatico quando si crea una
tabella.

Penso tu abbia ragione, infatti tutte le Options del Ribbon
sono selezionate e non comprendono la progettazione.
Però io mi riferisco a una tabella creata nel file che sto usando
(quello di casanmaner)...
Fine del problema comunque, poiché io le tabelle non le uso.
Bruno

Ma tu selezioni una cella all'interno della tabella?

No, seleziono l'intera tabella.

Post by casanmaner
Comunque Bruno le tabelle sono una delle cose più comode da utilizzare in
vba. Non devi più preoccuparti di riferimenti che in vba risultano statici :)
Per me l'invenzione migliore da Excel 2007 :)

Comode da utilizzare in operazioni Worksheet... ma non VBA.

Come ho già detto, con:

Dim R As Range
Set R = Range([Sheet5!A1], [Sheet5!A1].End(xlDown).End(xlToRight))

il range è completamente dinamico... automaticamente.

Ho intenzione, a titolo di esperimento, di trasformare nel tuo
programma
le tabelle in range, poi nella mia procedura sostituire i range in
matrici in RAM... e vederne le differenze.
In questi giorni però ho altro da fare.

Bruno

[casanmaner]

Post by Bruno Campanini

Post by casanmaner

Post by Bruno Campanini

Post by ***@gmail.com
Ciao non credo che sia deselezionata è automatico quando si crea una
tabella.

Penso tu abbia ragione, infatti tutte le Options del Ribbon
sono selezionate e non comprendono la progettazione.
Però io mi riferisco a una tabella creata nel file che sto usando
(quello di casanmaner)...
Fine del problema comunque, poiché io le tabelle non le uso.
Bruno

Ma tu selezioni una cella all'interno della tabella?

No, seleziono l'intera tabella.

Post by casanmaner
Comunque Bruno le tabelle sono una delle cose più comode da utilizzare in
vba. Non devi più preoccuparti di riferimenti che in vba risultano statici :)
Per me l'invenzione migliore da Excel 2007 :)

Comode da utilizzare in operazioni Worksheet... ma non VBA.

Ti posso assicurare che da quanto le utilizzo non ho necessità di fare modifiche al codice vba anche se cambio intervalli, sposto colonne o altro.
In pratica intercetti esattamente gli intervalli di interesse senza dover riscrivere codice vba ad es. per cambiare la riga di riferimento da cui partire o le colonne.

Post by Bruno Campanini
Dim R As Range
Set R = Range([Sheet5!A1], [Sheet5!A1].End(xlDown).End(xlToRight))
il range è completamente dinamico... automaticamente.

In questo caso molto semplicistico.
In altri casi più elaborati dovresti andare a indicare qual è il range inziale, magari la colonna di riferimento e se cambi qualcosa poi devi cambirare il codice in vba.

Post by Bruno Campanini
Ho intenzione, a titolo di esperimento, di trasformare nel tuo
programma
le tabelle in range

Non otteresti alcun vantaggio da questa trasfromazione :)
Ma ovviamente non ti posso dire come giocare :)


ciao

[Bruno Campanini]

Post by casanmaner

Post by Bruno Campanini

Post by Bruno Campanini

Post by ***@gmail.com
Ciao non credo che sia deselezionata è automatico quando si crea una
tabella.

Penso tu abbia ragione, infatti tutte le Options del Ribbon
sono selezionate e non comprendono la progettazione.
Però io mi riferisco a una tabella creata nel file che sto usando
(quello di casanmaner)...
Fine del problema comunque, poiché io le tabelle non le uso.
Bruno

Ma tu selezioni una cella all'interno della tabella? No, seleziono l'intera
tabella.
Comunque Bruno le tabelle sono una delle cose più comode da utilizzare in
vba. Non devi più preoccuparti di riferimenti che in vba risultano statici
:) Per me l'invenzione migliore da Excel 2007 :)

Comode da utilizzare in operazioni Worksheet... ma non VBA.

Ti posso assicurare che da quanto le utilizzo non ho necessità di fare
modifiche al codice vba anche se cambio intervalli, sposto colonne o altro.
In pratica intercetti esattamente gli intervalli di interesse senza dover
riscrivere codice vba ad es. per cambiare la riga di riferimento da cui
partire o le colonne.

Post by Bruno Campanini
Dim R As Range
Set R = Range([Sheet5!A1], [Sheet5!A1].End(xlDown).End(xlToRight))
il range è completamente dinamico... automaticamente.

In questo caso molto semplicistico.
In altri casi più elaborati dovresti andare a indicare qual è il range
inziale, magari la colonna di riferimento e se cambi qualcosa poi devi
cambirare il codice in vba.

In quali altri casi più elaborati? un esempio!

Post by casanmaner

Post by Bruno Campanini
Ho intenzione, a titolo di esperimento, di trasformare nel tuo
programma
le tabelle in range

Non otteresti alcun vantaggio da questa trasfromazione :)
Ma ovviamente non ti posso dire come giocare :)

Ripensandici non lo posso fare a meno di ulteriori modificazioni.
Hai definito come Tabella1 non solo le due colonne degli
ambi ma anche la terza colonna C destinata a contenere le frequenze.

Bruno

[casanmaner]

Post by Bruno Campanini

Post by Bruno Campanini
Dim R As Range
Set R = Range([Sheet5!A1], [Sheet5!A1].End(xlDown).End(xlToRight))

In quali altri casi più elaborati? un esempio!

Potrei farti vedere diversi miei lavori :)

Post by Bruno Campanini
Set R = Range([Sheet5!A1], [Sheet5!A1].End(xlDown).End(xlToRight))

Metti caso che un utente abbia necessità di inserire qualche riga sopra.
O spostare il tutto a partire da colonna B o successive.

Tu devi andare in VBA e cercare nel tuo codice il riferimento A1 e andare a modificarlo ovunque sia presente (o nel caso tu sia stato bravo e abbai dichiarato una costante quando mento andare a cambiare quella costante).

Il riferimento fatto alla tabella, come ho fatto io, non comporterebbe alcuna modifica al codice vba.
Ovunque si trovi posizionata la tabella, ovviamente in questo caso nel foglio dove è presente, il suo "range" è sempre individuato.

Sempre per fare altro esempio Sal per ridimensionare la tabella ha scritto queste righe:

Righe aggiunte -----------------------------------------------------
Dim sh As Worksheet
Set sh = Worksheets("RicercheSenzaparametri&date")
i = sh.Cells(Rows.Count, 5).End(xlUp).Row
With sh
.ListObjects("Tabella2").Resize .Range("E1").Offset(0, 0).Resize(i, 6)
End With
fine righe aggiunte ------------------------------------------------- prima di


io gli ho risposto di sostituire questa istruzione già presente:
arrEstrazioni = oLo2.DataBodyRange.Value

con

With oLo2
.Resize .Range.CurrentRegion
arrEstrazioni = .DataBodyRange.Value
End With

non ho dovuto fare "voli pindarici" per cercare l'intervallo da andare a ridimensionare.
In pratica ho aggiunto una sola riga di istruzioni (in questo caso 4 perché ho utilizzato il With che avrei potuto non utilizzare ma che io tendo ad usare appena ho due utilizzi dello stesso oggetto per mia abitudine).

Post by Bruno Campanini
Ripensandici non lo posso fare a meno di ulteriori modificazioni.
Hai definito come Tabella1 non solo le due colonne degli
ambi ma anche la terza colonna C destinata a contenere le frequenze.

Il tutto facendo riferimento sempre alla stessa tabella e solo alla sua "ListColum" specifica :)

Quella tabella, all'interno di quel foglio ovviamente, la puoi spostare dove vuoi e i dati degli ambi saranno sempre presi dalle prime due colonne e i risultati delle ricerche sempre riportati nella terza colonna.
E non dovrai stabilire nel vba nuovi parametri per intercettare i range di interesse.

Certo se la sposti in altro foglio occorre modificare il riferimento al foglio.
Anche se penso che potrebbe farsi riferimento al nome per individuare il foglio e volendo creare un codice che in base al nome univoco della tabella associarlo al foglio "parent".
Non ho mai provato perché non ne ho avuto necessità ma penso sarebbe possibile.

Se per te questo non è comodo per me lo è moltissimo.
Già in passato ho sempre lavorato utilizzando i nomi per avere dei punti di riferimento per poi non dover andare a modificare il vba.
Con le tabelle, dove posso utilizzarle, non ho nemmeno più bisogno di crear "nomi" di appoggio.
E anche con le intestazioni se sposti una colonna ma fai riferimento al "nome" (l'intestazione) della colonna ovunque essa sia posizionata all'interno della tabella sarà sempre intercettata in VBA senza modifiche al codice.

Per me non ha prezzo questa possibilità :)

[casanmaner]

Potrei farti anche un altro esempio banale.
Metti caso che da una ricerca vengano sempre estratti dati differenti (in base ai dati presenti nella ricerca) e che quindi ogni volta l'intervallo di destinazione debba essere pulito.
Nel VBA hai impostato i riferimenti alle celle, hai fatto la ricerca dell'ultima riga, hai cancellato i dati per poi riversare i dati della ricerca.
Nella Tabella al vba dai l'istruzione di eliminare tutte le righe e dopo aver eliminato le righe gli riversi la matrice contenente i dati.
Ad es. con queste istruzioni:

With oLo
With .DataBodyRange
.Delete
.Resize(NumRighe, NumCol).Value = arrDati
End With
End With

dove olo è la "tabella" dichiarata tramite Set elimini tutte le righe del corpo dati della tabella e automaticamente la ridimensioni inserendo i dati presenti nella matrice arrDati.

La tabella la puoi spostare e i dati finiranno sempre lì senza alcuna modifica al codice.

Vedi questo file di esempio dove semplicemente in base al valore presente nella tabella nominata "TabellaNumeroRecord" viene riempita la tabella che ho nominato "Report".

Nel codice faccio riferimento alle tabelle e non ad intervalli e senza dover cercare ultima riga, ultima colonna, numero colonne dell'intervallo a partire dalla prima colonna prefissata e l'ultima.
Il numero di colonne lo ottengo dalla proprietà della tabella.

Se sposto la tabella i dati vengono riversati sempre nella stessa senza dover riscrivere una riga di codice.

Nell'esempio stupido se volessi postare la tabella dove inserisco il numero di righe - ora in J7 - che va a formare l'array poi riportato in tabella non devo indicare dove si trova la cella da cui pesare il valore (che in questo caso mi serve solo per creare una matrice a caso ovviamente).
Tu per scrivere la stessa procedura dovresti indicare che
NumRighe = Range("J7").value

se sposti la cella per qualche necessità devi andare in VBA e scrivere il nuovo riferimento.
Se non vuoi fare ciò devi crearti un nome che faccia riferimento a quella cella e utilizzare quel nome nel codice VBA.

Se tu volessi in successive istruzioni andare a prendere ad es. i dati presenti nella colonna "Colonna2" non dovresti fare altro che scrivere una istruzione di questo tipo:
arrDatiColonna2 = oLoReport.ListColumns("Colonna2").DataBodyRange.Value

In un eventuale codice che si basi sui "range" dovresti andare ad inviduare qual è la colonna in base alla lettera o l'indice della stessa.
Se poi sposti qualcosa ecco che dovresti andare a correggere il codice.

Insomma l'uso delle "tabelle" anche in VBA ha i sui vantaggi rispetto ai riferimenti "statici" dei range.

Certo le tabelle hanno le loro particolarità e vanno comprese e conosciute ma personalmente dove è possibile io le utilizzo molto volentieri :)

ciao

[casanmaner]

Post by casanmaner
Potrei farti anche un altro esempio banale.
Metti caso che da una ricerca vengano sempre estratti dati differenti (in base ai dati presenti nella ricerca) e che quindi ogni volta l'intervallo di destinazione debba essere pulito.
Nel VBA hai impostato i riferimenti alle celle, hai fatto la ricerca dell'ultima riga, hai cancellato i dati per poi riversare i dati della ricerca.
Nella Tabella al vba dai l'istruzione di eliminare tutte le righe e dopo aver eliminato le righe gli riversi la matrice contenente i dati.
With oLo
With .DataBodyRange
.Delete
.Resize(NumRighe, NumCol).Value = arrDati
End With
End With
dove olo è la "tabella" dichiarata tramite Set elimini tutte le righe del corpo dati della tabella e automaticamente la ridimensioni inserendo i dati presenti nella matrice arrDati.
La tabella la puoi spostare e i dati finiranno sempre lì senza alcuna modifica al codice.
Vedi questo file di esempio dove semplicemente in base al valore presente nella tabella nominata "TabellaNumeroRecord" viene riempita la tabella che ho nominato "Report".
Nel codice faccio riferimento alle tabelle e non ad intervalli e senza dover cercare ultima riga, ultima colonna, numero colonne dell'intervallo a partire dalla prima colonna prefissata e l'ultima.
Il numero di colonne lo ottengo dalla proprietà della tabella.
Se sposto la tabella i dati vengono riversati sempre nella stessa senza dover riscrivere una riga di codice.
Nell'esempio stupido se volessi postare la tabella dove inserisco il numero di righe - ora in J7 - che va a formare l'array poi riportato in tabella non devo indicare dove si trova la cella da cui pesare il valore (che in questo caso mi serve solo per creare una matrice a caso ovviamente).
Tu per scrivere la stessa procedura dovresti indicare che
NumRighe = Range("J7").value
se sposti la cella per qualche necessità devi andare in VBA e scrivere il nuovo riferimento.
Se non vuoi fare ciò devi crearti un nome che faccia riferimento a quella cella e utilizzare quel nome nel codice VBA.
arrDatiColonna2 = oLoReport.ListColumns("Colonna2").DataBodyRange.Value
In un eventuale codice che si basi sui "range" dovresti andare ad inviduare qual è la colonna in base alla lettera o l'indice della stessa.
Se poi sposti qualcosa ecco che dovresti andare a correggere il codice.
Insomma l'uso delle "tabelle" anche in VBA ha i sui vantaggi rispetto ai riferimenti "statici" dei range.
Certo le tabelle hanno le loro particolarità e vanno comprese e conosciute ma personalmente dove è possibile io le utilizzo molto volentieri :)
ciao

ops ho dimenticato il link al file di esempio :)

https://www.dropbox.com/s/epi2hooyeq7zasg/Esempio%20Utilit%C3%A0%20Tabelle%20nel%20VBA.xlsm?dl=0

[Bruno Campanini]

casanmaner wrote on 02-11-20 :

Mi hai convinto solo per quanto riguarda lo spostamento delle
tabelle vs lo spostamento dei range.
Eventuialità ammetterai più teorica che pratica.

In ogni caso io, usando range, dovrei correggere solo una variabile,
anche, ma non lo faccio sempre, quando trattasi di più range:
- un range dipende da una sola cella
- gli altri range dipendona ancora da celle uniche che sono Offset
della origine del primo range che di solito, all'occorrenza, chiamo
StartCell.

Così, a parer mio, è come due scrittori che descrivano un avvenimento
usando correttamente espressioni diverse: l'importante è che ambedue
rendano veritiera e comprensibile la vicenda.

Però mi devi ancora spiegare perché io non posso editare le tabelle
che tu hai scritto nel tuo file.
Il motivo per cui vorrei farlo non è puro puntiglio: i miei risultati
differiscono in parte dai tuoi.
Ora controllare i risultati di cicli di 4005 x 12000 è un'impresa
cui proprio non mi accingo.
Vorrei paragonare i tuoi risultati coi miei da cicli 10 x 100.
Ora per quanto mi riguarda dovrei rendere blank le righe 11 e 101
dei due range.
Ma con le tue tabelle come faccio? non solo posso editarle ma
nemmeno eliminarle!.

Bruno

[Bruno Campanini]

Ma con le tue tabelle come faccio? non solo NON posso editarle ma
nemmeno POSSO eliminarle!.
Bruno

[casanmaner]

Post by Bruno Campanini
Mi hai convinto solo per quanto riguarda lo spostamento delle
tabelle vs lo spostamento dei range.
Eventuialità ammetterai più teorica che pratica.

Non non posso ammettere perché nella mia pratica invece ho avuto necessità di spostare dati per aggiungere righe in testa o colonne nel mezzo.
Ho un progetto legato ai leasing che non oso modificare se non mettendo colonne solo alla fine se necessario per altri calcoli e sperando che non sia necessario metterle nel mezzo perché basato proprio sugli offset a partire da una "cellastart".
Dovessi dover aggiungere una solo colonna tra la "cellastart" e le altre colonne e dovrei rivedere a cascata tutta una serie di valori di offeset.
Lo riscrivessi oggi quel progetto, cosa che non mi sogno di fare per la complessità, utilizzando le colonne la cosa sarebbe notevolmente più semplice almeno per quanto riguarda il vba.

Post by Bruno Campanini
In ogni caso io, usando range, dovrei correggere solo una variabile,
- un range dipende da una sola cella
- gli altri range dipendona ancora da celle uniche che sono Offset
della origine del primo range che di solito, all'occorrenza, chiamo
StartCell.

Con i "range" è quello che alla fine faccio anche io (con il fatto comunque di nominare a livello di foglio la "cellastart" così almeno quella è sempre intercettata dal VBA a prescindere di quale sia il suo "indirizzo".
Però come ho detto prima se per qualche motivo devi modificare il progetto dovendo inserire o eliminare delle colonne poi devi rivedere gli offset di tutte quelle colonne che si spostano a sinistra o a destra risultando posizionate in un offset differente.
Con una tabella il riferimento sarà sempre all'intestazione e una eventuale offset tra una colonna e l'altra sarà data dalla differenza di indice della colonna nella tabella, indici che sono sempre rilevabili in base all'intestazione.
Se voglio sapere quante colonne ci sono tra "Campo A" e "Campo B" sfruttando la proprietà indice della ListColumn faccio la differenza tra i due indici. Se sposto le colonne, ne aggiungo, ne elimino in VBA otterrò sempre la differenza corretta senza andare a modificare gli offset da una cella di partenza.

Post by Bruno Campanini
Così, a parer mio, è come due scrittori che descrivano un avvenimento
usando correttamente espressioni diverse: l'importante è che ambedue
rendano veritiera e comprensibile la vicenda.

Diciamo che con le tabelle posso impostare una struttura del racconto che per raccontare la stessa cosa non deve essere modificato o può essere modificato molto meno :)

Post by Bruno Campanini
Però mi devi ancora spiegare perché io non posso editare le tabelle
che tu hai scritto nel tuo file.
Il motivo per cui vorrei farlo non è puro puntiglio: i miei risultati
differiscono in parte dai tuoi.
Ora controllare i risultati di cicli di 4005 x 12000 è un'impresa
cui proprio non mi accingo.
Vorrei paragonare i tuoi risultati coi miei da cicli 10 x 100.
Ora per quanto mi riguarda dovrei rendere blank le righe 11 e 101
dei due range.
Ma con le tue tabelle come faccio? non solo posso editarle ma
nemmeno eliminarle!.

Per trasformare le tabelle in intervalli c'è l'apposita funzione nella tab "progettazione". Dovresti capire perché tu non la trovi.
In alternativa facendo click destro in una cella all'interno della tabella nel menù contestuale dovresti avere una sezione "Tabella" e un comando "Converti in intervallo".
Vedi screenshot:
Loading Image...

Comunque vedi questo file dove ho modificato il codice VBA per fare in modo che i dati sia dalla tabella ambi che dalla tabella estrazioni vengano presi in base alla CurrentRegion.
In questo modo ti basterà lasciare vuota una riga nelle tabelle e i dati elaborati saranno quelli fino alla riga precedente a quella vuota per entrambe.

https://www.dropbox.com/s/vzaq332u8hs4hx6/Ricerca%20Ambi%20Bruno%201.xlsm?dl=0

ciao

[[e-mail]]

Ciao Casanmaner, a questo punto mi sta interessando il discorso sulle tabelle.
però ti chiedo una cosa, come faccio a scorrere la tabella in questi 2 casi
1°
questa porzione di codice, rileva i ritardi storici, attuali e le frequenze di un ambo
For y = 2 To r1
Set rng = Range("F" & y & ":J" & y)
n = WorksheetFunction.CountIf(rng, d1) + WorksheetFunction.CountIf(rng, d2)
If n = 2 Then
Fq = Fq + 1
If Ra > Rs Then Rs = Ra
Ra = 0
End If
Ra = Ra + 1
Next y
non guardare variabili o altro ma solo il range
come vedi scorro un range alla volta per passarlo alla funzione countif, per vedere se è uscito un ambo d1,d2.
posso farlo normale come ho fatto o ce un altro metodo

2°
quest'altra porzione di codice serve per scrivere il tabellone analitico, che riporta solamente i numeri usciti nelle estrazioni progressivamente nel tempo, eliminando doppioni
For x = 2 To Cells(Rows.Count, 4).End(xlUp).Row
Set rng = Range("F1:j" & x - 1)
For y = 6 To 10
d = Cells(x, y)
n = WorksheetFunction.CountIf(rng, d)
If n >= 1 Then Else Cells(x, y + 5) = d
Next y
Next x
in questo caso però il range parte sempre da F1 aumentando di una riga ad ogni passaggio fermo restando F1, quindi il range aumenta di dimensione
se lo faccio cosi sulla tabella è lo stesso.

la cosa più difficile a questo mondo è cercare di spiegarsi sperando che gli altri capiscano il tuo intento

Ciao By Sal (8-D

[casanmaner]

Post by ***@gmail.com
Ciao Casanmaner, a questo punto mi sta interessando il discorso sulle tabelle.
però ti chiedo una cosa, come faccio a scorrere la tabella in questi 2 casi
1°
questa porzione di codice, rileva i ritardi storici, attuali e le frequenze di un ambo
For y = 2 To r1
Set rng = Range("F" & y & ":J" & y)
n = WorksheetFunction.CountIf(rng, d1) + WorksheetFunction.CountIf(rng, d2)
If n = 2 Then
Fq = Fq + 1
If Ra > Rs Then Rs = Ra
Ra = 0
End If
Ra = Ra + 1
Next y
non guardare variabili o altro ma solo il range
come vedi scorro un range alla volta per passarlo alla funzione countif, per vedere se è uscito un ambo d1,d2.
posso farlo normale come ho fatto o ce un altro metodo
2°
quest'altra porzione di codice serve per scrivere il tabellone analitico, che riporta solamente i numeri usciti nelle estrazioni progressivamente nel tempo, eliminando doppioni
For x = 2 To Cells(Rows.Count, 4).End(xlUp).Row
Set rng = Range("F1:j" & x - 1)
For y = 6 To 10
d = Cells(x, y)
n = WorksheetFunction.CountIf(rng, d)
If n >= 1 Then Else Cells(x, y + 5) = d
Next y
Next x
in questo caso però il range parte sempre da F1 aumentando di una riga ad ogni passaggio fermo restando F1, quindi il range aumenta di dimensione
se lo faccio cosi sulla tabella è lo stesso.
la cosa più difficile a questo mondo è cercare di spiegarsi sperando che gli altri capiscano il tuo intento
Ciao By Sal (8-D

Ciao non ho capito come mai per il secondo intervallo parti dalle intestazioni e non dai dati.
Comunque prova questo esempio per vedere se gli intervalli di interesse, che vengono "stampati" nella finestra immediata (Ctrl+g in vba) sono quelli di interesse.
Fai partire con F8 ed esegui il ciclo un passo alla volta per vedere gli address degli intervalli intercettati.

Sub Test2()
Dim oLo1 As ListObject
Dim oLo2 As ListObject
Dim y As Long
With ThisWorkbook
With .Worksheets("RicercheSenzaparametri&date")
Set oLo1 = .ListObjects("Tabella1")
Set oLo2 = .ListObjects("Tabella2")
End With
End With
With oLo2
For y = 1 To .ListRows.Count
'I° intervallo
Debug.Print "Intervallo 1: " & .DataBodyRange(y, 1).Resize(1, 5).Offset(0, 1).Address
'II° intervallo
Debug.Print "Intervallo 2: " & .DataBodyRange(1, 1).Resize(y, 5).Offset(0, 1).Address
Next y
End With
End Sub

[[e-mail]]

Post by casanmaner

Post by ***@gmail.com
la cosa più difficile a questo mondo è cercare di spiegarsi sperando che gli altri capiscano il tuo intento
Ciao By Sal (8-D

Ciao non ho capito come mai per il secondo intervallo parti dalle intestazioni e non dai dati.

Ciao Casanmaner, il fatto che nel secondo esempio parto dalle intestazioni te lo spiego con un immagine, questa
Loading Image...

si tratta di una tabella analitica quella verde che mano mano che scorre in basso elimina i valori ripetuti, facendo il confronto con la riga superiore se sono presenti gli stessi valori nella riga inferiore non li riporta.
ecco perche la prima partenza parte dalle intestazioni, infatti riporta tutti i 5 valori della sx.

scendendo vedi che mano mano alcuni valori non vengono riportati sono già usciti precedentemente
scorrendo sempre in basso si arriva ad un punto che sono usciti tutti i numeri

ora controllo i vari passaggi che mi hai proposto per vedere il comportamento, grazie per il tempo che mi stai dedicando.

Ciao By Sal (8-D

[casanmaner]

Post by ***@gmail.com

Post by casanmaner

Post by ***@gmail.com
la cosa più difficile a questo mondo è cercare di spiegarsi sperando che gli altri capiscano il tuo intento
Ciao By Sal (8-D

Ciao non ho capito come mai per il secondo intervallo parti dalle intestazioni e non dai dati.

Ciao Casanmaner, il fatto che nel secondo esempio parto dalle intestazioni te lo spiego con un immagine, questa
https://i.postimg.cc/2jHT51Bw/Cattura.png
si tratta di una tabella analitica quella verde che mano mano che scorre in basso elimina i valori ripetuti, facendo il confronto con la riga superiore se sono presenti gli stessi valori nella riga inferiore non li riporta.
ecco perche la prima partenza parte dalle intestazioni, infatti riporta tutti i 5 valori della sx.
scendendo vedi che mano mano alcuni valori non vengono riportati sono già usciti precedentemente
scorrendo sempre in basso si arriva ad un punto che sono usciti tutti i numeri
ora controllo i vari passaggi che mi hai proposto per vedere il comportamento, grazie per il tempo che mi stai dedicando.
Ciao By Sal (8-D

dall'immagine non si vedono i riferimenti alle colonne, ma credo che stando così la tabella occorrerà modificare qualche parametro perché io partivo dall'idea che la tabella fosse composta dalle 6 colonne delle estrazioni.

[[e-mail]]

Ciao diciamo che fossero 2 tabelle la prima D-J la seconda K-O, però io una volta ho provato a creare 2 tabelle adiacenti, non sono riuscito a crearle me ne creava sempre 1 ingrandendo la prima
oppure la prima soltanto K-J tralasciando data e numero progressivo, visto che nel caso non servono servono solo i 5 numeri

ecco l'immagine
Loading Image...

Ciao By Sal (8-D

[casanmaner]

Post by ***@gmail.com
Ciao diciamo che fossero 2 tabelle la prima D-J la seconda K-O, però io una volta ho provato a creare 2 tabelle adiacenti, non sono riuscito a crearle me ne creava sempre 1 ingrandendo la prima
oppure la prima soltanto K-J tralasciando data e numero progressivo, visto che nel caso non servono servono solo i 5 numeri
ecco l'immagine
https://i.postimg.cc/GpPG5xTb/Cattura.png
Ciao By Sal (8-D

Personalmente se ti servono anche le colonne che vanno da K a O utilizzerei una sola tabella.
Le intestazioni della seconda parte eventualmente differenziandole per uno spazio o un anderscore e poi lavorerei su quella tabella.
Appena ho un momento vedo di farti un esempio sulla tabella unica su come intercettare eventuali intervalli di interesse.

[casanmaner]

Post by casanmaner

Post by ***@gmail.com
Ciao diciamo che fossero 2 tabelle la prima D-J la seconda K-O, però io una volta ho provato a creare 2 tabelle adiacenti, non sono riuscito a crearle me ne creava sempre 1 ingrandendo la prima
oppure la prima soltanto K-J tralasciando data e numero progressivo, visto che nel caso non servono servono solo i 5 numeri
ecco l'immagine
https://i.postimg.cc/GpPG5xTb/Cattura.png
Ciao By Sal (8-D

Personalmente se ti servono anche le colonne che vanno da K a O utilizzerei una sola tabella.
Le intestazioni della seconda parte eventualmente differenziandole per uno spazio o un anderscore e poi lavorerei su quella tabella.
Appena ho un momento vedo di farti un esempio sulla tabella unica su come intercettare eventuali intervalli di interesse.

Vedi questo file:

https://www.dropbox.com/s/vzaq332u8hs4hx6/Ricerca%20Ambi%20Bruno%201.xlsm?dl=0

dove è presente il Foglio1 con una tabella simile alla tua (noterai che le ultime 5 colonne hanno come nome "Na_1,....".
Questo perché poiché le tabelle non possono avere colonne con gli stessi nomi ho preferito inserire l'underscore piuttsto che avere un nome tipo "Na12,...".
Nel modulo5 del progetto vba ho inserito questa semplice macro:

Sub TestIntercettaIntervalli()
Dim oLo3 As ListObject
Dim iOffSet As Long
Dim iResize As Long
Dim i As Long

With ThisWorkbook
With .Worksheets("Foglio1")
Set oLo3 = .ListObjects("Tabella3")
End With
End With

With oLo3

iOffSet = .ListColumns("Na1").Index - .ListColumns(1).Index
iResize = .ListColumns("Na5").Index - .ListColumns("Na1").Index + 1

'I° intervallo ricercato a partire dalla prima riga dati
For i = 1 To .ListRows.Count
Debug.Print "Intervallo 1: " & .DataBodyRange(i, 1).Resize(1, iResize).Offset(0, iOffSet).Address
Next i
'II° intervallo ricercato a partire dalle intestazioni
For i = 1 To .Range.Rows.Count
Debug.Print "Intervallo 2: " & .Range(1, 1).Resize(i, iResize).Offset(0, iOffSet).Address
Next i
End With

End Sub

Nel primo ciclo dovrei intercettare l'intervallo per ciascuna riga delle colonne corrispondenti a quelle da N1 a N5. Questo a partire dalla prima riga dati.

Nel secondo ciclo riproduco l'intervallo "incrementale" ma, come da tuo esempio originario, a partire dalle intestazioni, prendendo sempre le colonne che vanno da N1 a N5 ma con l'intervallo per righe che si incrementa da 1 (riga intestazioni) fino all'ultima riga (ultima riga dei dati).

Nota che il valore di offset è dato dalla differenza tra l'indice che assume la colonna "N1", che è quella iniziale dell'intervallo che ti interessa, e la prima colonna (in questo caso ho fatto riferimento al numero di indice e non al nome/testo intestazione perché mi interessa partire sempre dalla prima colonna).
Per il resize invece faccio riferimento alla differenza tra gli indici delle colonne da N1 a N5 (a cui aggiungo 1).

Vedi se ti ci capisci :)

Vedi se ti ci capisci.

[[e-mail]]

Ciao Ho visto, allora come da esempio, nella stessa tabella, posso scorrere i dati che voglio, con il tuo sistema.

non usavo le tabelle causa le formule, ma con il vba è più semplice.

oltretutto con le formule non sono molto bravo.

Ciao By Sal (8-D

[casanmaner]

Post by ***@gmail.com
Ciao Ho visto, allora come da esempio, nella stessa tabella, posso scorrere i dati che voglio, con il tuo sistema.
non usavo le tabelle causa le formule, ma con il vba è più semplice.
oltretutto con le formule non sono molto bravo.
Ciao By Sal (8-D

Se non vuoi che le formule si estendano tutte automaticamente per l'intera colonna devi disabilitare l'opzione presente nella sezione "correzioni automatiche".

Inoltre puoi sempre pensare di usare i riferimenti alle celle normalmente anche se ovviamente quando si seleziona una cella viene proposto il linguaggio tipico della tabella.

Per il VBA a mio parere avere come riferimento tabelle invece che intervalli ha solo vantaggi se i dati sono organizzati proprio in "schematabellare".

Diverso se i dati fossero sparsi in giro per il foglio senza uno schema tabellare.
Anche se io ho tendo sempre a nominare le celle per fare riferimento al loro nome e non al loro "indirizzo".

[Bruno Campanini]

A proposito della tua ottima procedura RIcercaAmbi ho provato a
riscrivere la mia da 45 minuti utilizzando Dictionary: niente da fare
la ricerca dell'ambo nella sestina si fa in un lampo
(If D.Exists(Ambo1) And D.Exists(Ambo2) etc), però caricare una
singola sestina per volta nel dizionario costa parecchio tempo.
Non sono riuscito a ottenere i risultati giusti in meno di 5 minuti.

Allora ho provato con gli array seguendo la tua logica ma usando range
anziché tabelle. Il tempo si è ridotto a meno di 3 minuti
(un'esagerazione in rapporto alla tua manciata di secondi).

E non riesco a capire il motivo della enorme differenza:
ci sono 2 cose da considerare:
- le tue tabelle vs i miei range
- il fatto che tu risolvi il problema solo se gli ambi e le
sestine sono ordinati crescenti per riga da sinistra a destra
(io invece risolvo il tutto ancorché disordinato)

Ho provato a eliminare la t in:
For y = t + 1 To UBound(arrEstrazioni, 2) e a riscrivere un ambo
da 15-25 a 25-15: il tempo semplicemente raddoppia (23") e i risultati
sono quelli giusti.

Tutta la differenza sta in Tables vs Ranges?

Bruno

[casanmaner]

Post by Bruno Campanini
A proposito della tua ottima procedura RIcercaAmbi ho provato a
riscrivere la mia da 45 minuti utilizzando Dictionary: niente da fare
la ricerca dell'ambo nella sestina si fa in un lampo
(If D.Exists(Ambo1) And D.Exists(Ambo2) etc), però caricare una
singola sestina per volta nel dizionario costa parecchio tempo.
Non sono riuscito a ottenere i risultati giusti in meno di 5 minuti.
Allora ho provato con gli array seguendo la tua logica ma usando range
anziché tabelle. Il tempo si è ridotto a meno di 3 minuti
(un'esagerazione in rapporto alla tua manciata di secondi).
- le tue tabelle vs i miei range
- il fatto che tu risolvi il problema solo se gli ambi e le
sestine sono ordinati crescenti per riga da sinistra a destra
(io invece risolvo il tutto ancorché disordinato)
For y = t + 1 To UBound(arrEstrazioni, 2) e a riscrivere un ambo
da 15-25 a 25-15: il tempo semplicemente raddoppia (23") e i risultati
sono quelli giusti.
Tutta la differenza sta in Tables vs Ranges?

Nella mia procedura le tabelle le uso solo per prelevare i dati e inserire i dati.
La ricerca viene fatta solo a livello di matrici.
Se hai modificato eliminando la t il tempo aumenta perché l'array viene "spazzolato" sempre per 6 colonne e non a scalare avendo sempre meno dati da ciclare.
Io mi ero basato su come erano presenti i dati nell'esempio e su come mi sembrava volesse operare Sal.


Rispetto all'aumento del tempo non ho capito se tu hai provato a fare la stessa ricerca utilizzando prima i range e poi le tabelle e se hai differenze per questo.
Ma non credo perché alla fine una tabella è un range. Solo che è definito e non hai necessità di intercettarlo con altri stratagemmi se non facendo riferimento al nome della tabella e alle sue componenti (databodyrange, listcolumns, ecc.). Ma alla fine sempre un "range" è.

[casanmaner]

Post by Bruno Campanini
A proposito della tua ottima procedura RIcercaAmbi ho provato a
riscrivere la mia da 45 minuti utilizzando Dictionary: niente da fare
la ricerca dell'ambo nella sestina si fa in un lampo
(If D.Exists(Ambo1) And D.Exists(Ambo2) etc), però caricare una
singola sestina per volta nel dizionario costa parecchio tempo.
Non sono riuscito a ottenere i risultati giusti in meno di 5 minuti.
Allora ho provato con gli array seguendo la tua logica ma usando range
anziché tabelle. Il tempo si è ridotto a meno di 3 minuti
(un'esagerazione in rapporto alla tua manciata di secondi).
- le tue tabelle vs i miei range
- il fatto che tu risolvi il problema solo se gli ambi e le
sestine sono ordinati crescenti per riga da sinistra a destra
(io invece risolvo il tutto ancorché disordinato)
For y = t + 1 To UBound(arrEstrazioni, 2) e a riscrivere un ambo
da 15-25 a 25-15: il tempo semplicemente raddoppia (23") e i risultati
sono quelli giusti.

Ho provato ad eliminare il contatore "t" alla riga:
'For y = t + 1 To UBound(arrEstrazioni, 2)

che è diventata:
For y = 1 To UBound(arrEstrazioni, 2)

e con il mio pc il tempo di elaborazione passa dai circa 20" ai circa 25" con una differenza di 5".

Nel tuo con quella sola modifica il tempo si raddoppia?

[[e-mail]]

Ciao, mi reinserisco nel discorso proprio perche ho avuto problemi con l'ordinamento dei dati sulla riga, trovata la soluzione ne faccio partecipe a tutti per l'aiuto che mi avete dato.
avendo anche dati non ordinati da sx a dx ed a volte anche 5 dati al posto di 6, estrazioni del Lotto, la tabella non permette di farlo infatti se leggi l'help dice che una tabella non può essere ordinata in orizzontale, deve essere prima trasformata in intervallo.
cercando una soluzione in rete mi sono imbattuto in questa macro che risolve il problema senza convertire la tabella.

Sub OrdinaCrescente()
Dim vector As Variant
Dim Rig As Long, Col As Long, Val As Long
Application.Calculation = xlManual

For Rig = 2 To Cells(Rows.Count, "E").End(xlUp).Row
'' carico in un vettore le celle interessate
vector = ActiveSheet.Range(Cells(Rig, "E"), Cells(Rig, "J"))
Col = 5 'colonna E
For Val = 1 To 6
If ActiveSheet.Cells(Rig, Col) = "" Then GoTo 1 'aggiunta per cella vuota finale 5 elementi
ActiveSheet.Cells(Rig, Col) = Application.Small(vector, Val)
''scrivo il valore dal piu' piccolo al piu' grande nella sua colonna
Col = Col + 1
1 Next Val
Next Rig
Application.Calculation = xlAutomatic
Calculate
End Sub

nel caso possa servire, un saluto Ciao By Sal (8-D

[casanmaner]

Post by ***@gmail.com
Ciao, mi reinserisco nel discorso proprio perche ho avuto problemi con l'ordinamento dei dati sulla riga, trovata la soluzione ne faccio partecipe a tutti per l'aiuto che mi avete dato.
avendo anche dati non ordinati da sx a dx ed a volte anche 5 dati al posto di 6, estrazioni del Lotto, la tabella non permette di farlo infatti se leggi l'help dice che una tabella non può essere ordinata in orizzontale, deve essere prima trasformata in intervallo.
cercando una soluzione in rete mi sono imbattuto in questa macro che risolve il problema senza convertire la tabella.
Sub OrdinaCrescente()
Dim vector As Variant
Dim Rig As Long, Col As Long, Val As Long
Application.Calculation = xlManual
For Rig = 2 To Cells(Rows.Count, "E").End(xlUp).Row
'' carico in un vettore le celle interessate
vector = ActiveSheet.Range(Cells(Rig, "E"), Cells(Rig, "J"))
Col = 5 'colonna E
For Val = 1 To 6
If ActiveSheet.Cells(Rig, Col) = "" Then GoTo 1 'aggiunta per cella vuota finale 5 elementi
ActiveSheet.Cells(Rig, Col) = Application.Small(vector, Val)
''scrivo il valore dal piu' piccolo al piu' grande nella sua colonna
Col = Col + 1
1 Next Val
Next Rig
Application.Calculation = xlAutomatic
Calculate
End Sub
nel caso possa servire, un saluto Ciao By Sal (8-D

È vero una tabella non può essere ordinata in orizzontale.
Non ne ho mai avuto la necessità ma vedo di creare una procedura standard per ordinare una qualsiasi tabella in orizzontale.
Vediamo che ne esce fuori :)

[casanmaner]

Ho provato a creare una funzione che restituisca una matrice di valori dove gli stessi, per ciascuna riga (che mi pare sia quello che tu cercavi), sono ordinati in orizzontale.
Come ho detto l'ordinamento è autonomo per ciascuna riga.
Non viene fatto un ordinamento come quello proposto da Excel in orizzontale dove indicando qual è la riga di riferimento l'ordinamento viene fatto per quella riga i valori delle altre righe si spostano di conseguenza (anche se magari all'interno di una riga i dati non sono ordinati).
In pratica se nella tabella di due righe e due colonne ci sono due valori:
5 - 2
2 - 5
la funzione restituirà i valori così ordinati:
2 - 5
2 - 5

Excel invece, se si impostasse come riga di riferimento la prima, restituirebbe:
2 - 5
5 - 2
spostando i valori della seconda riga in base alla posizione assunta dai valori valori ordinati.

Qui un file di esempio:
https://www.dropbox.com/s/vbtyytj0wkynowk/Ordinamento%20Orizzontale%20Tabella.xlsm?dl=0

È presente una tabella con dei valori da "lavorare".

Nel modulo1 c'a una sub

Sub Tester()
Dim iTimer: iTimer = Timer
Dim oLo As ListObject
Set oLo = ActiveSheet.ListObjects(1)
oLo.DataBodyRange.Value = OrdinamentoOrizzontaleSingoleRighe(oLo.DataBodyRange, xlAscending, True, False)

'Debug.Print Timer - iTimer
End Sub

che setta l'oggetto ListObject e poi fa in modo che il "corpo dei dati" della list object sia valorizzato dalla funzione i cui argomenti sono un Range (in questo caso il DataBodyRange della tabella), se l'ordinamento deve essere di tipo ascendente o discendente, se deve essere effettuato in confronto tra maiuscole/minuscole e, infine, se eventuali numeri devono essere trattati come stringa di testo.
Questi tre argomenti sono facoltativi e se non impostati assumono un valore predeterminato.

Questa la funzione che restituisci i valori ordinati per riga:

'Funzione più generica il cui argomento è un range
'Nel caso di utilizzo con una tabella basta impostare argomento "Rng" l'oggetto "DataBodyRange" di una ListObject

Function OrdinamentoOrizzontaleSingoleRighe(Rng As Range, _
Optional SortOrder As XlSortOrder = xlAscending, _
Optional bMatchCase As Boolean = False, _
Optional bNumberAsText As Boolean = False) As Variant
Dim arrDati As Variant
Dim i As Long, j As Long, t As Long
Dim vTmp1 As Variant, vTmp2 As Variant
Dim vTmp3 As Variant, vTmp4 As Variant

With Rng
arrDati = .Value
For i = 1 To .Rows.Count
'Spostamento spazi vuoti alla fine
For j = 1 To .Columns.Count - 1
For t = j + 1 To .Columns.Count
vTmp1 = arrDati(i, j)
vTmp2 = arrDati(i, t)
Debug.Print vTmp1, vTmp2
If vTmp1 = vbNullString Then
arrDati(i, j) = vTmp2
arrDati(i, t) = vTmp1
End If
Next t
Next j
'Ordinamento dati per ciascuna riga
For j = 1 To .Columns.Count - 1
For t = j + 1 To .Columns.Count
vTmp1 = arrDati(i, j)
vTmp2 = arrDati(i, t)
If vTmp1 <> "" And vTmp2 <> "" Then
'Numeri trattati come fossero una stringa di testo
If bNumberAsText Then
If IsNumeric(vTmp1) Then vTmp1 = Format(vTmp1, "@")
If IsNumeric(vTmp2) Then vTmp2 = Format(vTmp2, "@")
End If
'Confronto tra Maiuscole/Minuscole
If Not bMatchCase Then
If Not IsNumeric(vTmp1) Or bNumberAsText Then
vTmp1 = UCase(arrDati(i, j))
End If
If Not IsNumeric(vTmp2) Or bNumberAsText Then
vTmp2 = UCase(arrDati(i, t))
End If
End If
'Ordinamento valori
vTmp3 = arrDati(i, j)
vTmp4 = arrDati(i, t)
If SortOrder = xlAscending Then ' dal più piccolo al più grande
If vTmp1 > vTmp2 Then
arrDati(i, j) = vTmp4
arrDati(i, t) = vTmp3
End If
ElseIf SortOrder = xlDescending Then ' dal più grande al più piccolo
If vTmp2 > vTmp1 Then
arrDati(i, j) = vTmp4
arrDati(i, t) = vTmp3
End If
End If
End If ' vTmp1 <> "" And vTmp2 <> ""
Next t
Next j
Next i
End With
OrdinamentoOrizzontaleSingoleRighe = arrDati
End Function


Questa funzione fa riferimento a qualsiasi range venga passato all'argomento Rng e quindi il range potrebbe essere determinato anche con modi "classici" anche se non si tratti di una tabella.
Ad es. se si passasse un range del tipo Range("A1:C200") i valori presi sarebbero quelli di quell'intervallo.

Nel modulo2 c'è la stessa funzione ma più specifica poiché il primo argomento deve essere un oggetto ListObject.
Però alla fine restituisce sempre una matrice di valori che può essere assegnato a qualsiasi intervallo o altra tabella (previo dimensionamento della stessa in base alle dimensioni della matrice).


Poi se ho tempo vedo se riesco a "replicare" il funzionamento dell'ordinamento di Excel in orizzontale indicando almeno una riga di riferimento.
In excel i criteri possono essere "infiniti" tramite la funzione aggiungi ma da VBA penso sarebbe molto complesso già impostare 2 opzioni di riga ... almeno per me :)

[casanmaner]

Post by casanmaner
Debug.Print vTmp1, vTmp2

Questa riga può essere eliminata :)

[casanmaner]

In questa seconda versione del file:
https://www.dropbox.com/s/8ixl62cu4p1eeua/Ordinamento%20Orizzontale%20Tabella%20%232.xlsm?dl=0

Ho inserito nel modulo3 la funzione che restituisce i valori ordinati replicando quanto viene fatto da Excel nell'ordinamento orizzontale.

La funzione:
Function OrdinamentoOrizzontaleIntervallo(Rng As Range, _
Optional NumeroRigaOrdinamento As Long = 1, _
Optional SortOrder As XlSortOrder = xlAscending, _
Optional bMatchCase As Boolean = False, _
Optional bNumberAsText As Boolean = False)

ha come la precedente gli argomenti Rng, SortOrder, bMatchCase e bNumberAsText.
Inoltre come secondo argomento opzionahe ha "NumeroRigaOrdinamento".
Se non viene indicato un valore differente verrà presa la prima riga come riferimento.

Questa la function intera:

Function OrdinamentoOrizzontaleIntervallo(Rng As Range, _
Optional NumeroRigaOrdinamento As Long = 1, _
Optional SortOrder As XlSortOrder = xlAscending, _
Optional bMatchCase As Boolean = False, _
Optional bNumberAsText As Boolean = False)

Dim arrDati As Variant
Dim arrDatiRiga As Variant
Dim i As Long, j As Long, t As Long
Dim vTmp1 As Variant, vTmp2 As Variant
Dim vTmp3 As Variant, vTmp4 As Variant

With Rng
arrDati = .Value
arrDatiRiga = .Rows(NumeroRigaOrdinamento).Value
'Spostamento spazi vuoti alla fine
'For i = 1 To .Columns.Count
'For j = i + 1 To .Columns.Count
For i = .Columns.Count - 1 To 1 Step -1
vTmp1 = arrDatiRiga(1, i)
For j = .Columns.Count To i + 1 Step -1
vTmp2 = arrDatiRiga(1, j)
If vTmp1 = vbNullString And vTmp2 <> vbNullString Then
arrDatiRiga(1, i) = vTmp2
arrDatiRiga(1, j) = vTmp1
For t = 1 To .Rows.Count
vTmp3 = arrDati(t, i)
vTmp4 = arrDati(t, j)
arrDati(t, i) = vTmp4
arrDati(t, j) = vTmp3
Next t
End If
Next j
Next i
For i = 1 To .Columns.Count - 1
vTmp1 = arrDatiRiga(1, i)
For j = i + 1 To .Columns.Count
vTmp2 = arrDatiRiga(1, j)
If vTmp1 <> "" And vTmp2 <> "" Then
'Numeri trattati come fossero una stringa di testo
If bNumberAsText Then
If IsNumeric(vTmp1) Then vTmp1 = Format(vTmp1, "@")
If IsNumeric(vTmp2) Then vTmp2 = Format(vTmp2, "@")
End If
'Confronto tra Maiuscole/Minuscole
If Not bMatchCase Then
If Not IsNumeric(vTmp1) Or bNumberAsText Then
vTmp1 = UCase(arrDatiRiga(1, i))
End If
If Not IsNumeric(vTmp2) Or bNumberAsText Then
vTmp2 = UCase(arrDatiRiga(1, j))
End If
End If
'Ordinamento valori
If SortOrder = xlAscending Then ' dal più piccolo al più grande
If vTmp1 > vTmp2 Then
arrDatiRiga(1, i) = vTmp2
arrDatiRiga(1, j) = vTmp1
For t = 1 To .Rows.Count
vTmp3 = arrDati(t, i)
vTmp4 = arrDati(t, j)
arrDati(t, i) = vTmp4
arrDati(t, j) = vTmp3
Next t
End If
ElseIf SortOrder = xlDescending Then ' dal più grande al più piccolo
If vTmp2 > vTmp1 Then
arrDatiRiga(1, i) = vTmp2
arrDatiRiga(1, j) = vTmp1
For t = 1 To .Rows.Count
vTmp3 = arrDati(t, i)
vTmp4 = arrDati(t, j)
arrDati(t, i) = vTmp4
arrDati(t, j) = vTmp3
Next t
End If
End If
End If ' vTmp1 <> "" And vTmp2 <> ""
Next j
Next i
End With ' Rng
1 OrdinamentoOrizzontaleIntervallo = arrDati
End Function



Ho fatto qualche aggiustamento anche alle precedenti funzioni presenti nei moduli 1 e 2.

Una annotazione va fatta nella differenza in caso di ordinamento di testo con l'opzione "MatchCase" ("Maiuscole/minuscole" nelle opzioni di ordinamento).
Tra VBA e interfaccia utente excel c'è una differenza.
Ad es. in VBA "A" viene prima di "a" mentre in interfaccia utente per la funzione di ordinamento (sia che sia verticale che orizzontale) "a" viene prima di "A".

Questo si riflette sull'ordinamento dei dati tramite VBA.
Da tener presente se la cosa può avere rilevanza.

[casanmaner]

Nel precedente messaggio che ho eliminato mi sono accorto che alle funzioni avevo fatto una modifica che non andava bene.
Ripropongo quindi il file corretto con la funzione che cerca di "replicare" l'ordinamento orizzontale di Excel.
Questo il file:
https://www.dropbox.com/s/8ixl62cu4p1eeua/Ordinamento%20Orizzontale%20Tabella%20%232.xlsm?dl=0

Nel modulo3 è presente la funzione:
Function OrdinamentoOrizzontaleIntervallo
i cui argomenti sono:
Rng As Range, _
Optional NumeroRigaOrdinamento As Long = 1, _
Optional SortOrder As XlSortOrder = xlAscending, _
Optional bMatchCase As Boolean = False, _
Optional bNumberAsText As Boolean = False

L'argomento NumeroRigaOrdinamento, opzionale come gli altri, individua la riga sulla base della quale effettuare l'ordinamento dell'intervallo in orizzontale.

Questa è la function nella sua interezza:

Function OrdinamentoOrizzontaleIntervallo(Rng As Range, _
Optional NumeroRigaOrdinamento As Long = 1, _
Optional SortOrder As XlSortOrder = xlAscending, _
Optional bMatchCase As Boolean = False, _
Optional bNumberAsText As Boolean = False)

'Funzione che replica l'ordinamento orizzontale di Excel
'L'ordinamento avviene sulla base della riga indicata come riga di riferimento
'per l'ordinamento

Dim arrDati As Variant
Dim arrDatiRiga As Variant
Dim i As Long, j As Long, t As Long
Dim vTmp1 As Variant, vTmp2 As Variant
Dim vTmp3 As Variant, vTmp4 As Variant

With Rng
arrDati = .Value
arrDatiRiga = .Rows(NumeroRigaOrdinamento).Value
'Spostamento spazi vuoti alla fine
For i = .Columns.Count - 1 To 1 Step -1
For j = .Columns.Count To i + 1 Step -1
vTmp1 = arrDatiRiga(1, i)
vTmp2 = arrDatiRiga(1, j)
If vTmp1 = vbNullString And vTmp2 <> vbNullString Then
arrDatiRiga(1, i) = vTmp2
arrDatiRiga(1, j) = vTmp1
For t = 1 To .Rows.Count
vTmp3 = arrDati(t, i)
vTmp4 = arrDati(t, j)
arrDati(t, i) = vTmp4
arrDati(t, j) = vTmp3
Next t
End If
Next j
Next i
For i = 1 To .Columns.Count - 1
For j = i + 1 To .Columns.Count
vTmp1 = arrDatiRiga(1, i)
vTmp2 = arrDatiRiga(1, j)
If vTmp1 <> "" And vTmp2 <> "" Then
'Numeri trattati come fossero una stringa di testo
If bNumberAsText Then
If IsNumeric(vTmp1) Then vTmp1 = Format(vTmp1, "@")
If IsNumeric(vTmp2) Then vTmp2 = Format(vTmp2, "@")
End If
'Confronto tra Maiuscole/Minuscole
If Not bMatchCase Then
If Not IsNumeric(vTmp1) Or bNumberAsText Then
vTmp1 = UCase(arrDatiRiga(1, i))
End If
If Not IsNumeric(vTmp2) Or bNumberAsText Then
vTmp2 = UCase(arrDatiRiga(1, j))
End If
End If
'Ordinamento valori
If SortOrder = xlAscending Then ' dal più piccolo al più grande
If vTmp1 > vTmp2 Then
arrDatiRiga(1, i) = vTmp2
arrDatiRiga(1, j) = vTmp1
For t = 1 To .Rows.Count
vTmp3 = arrDati(t, i)
vTmp4 = arrDati(t, j)
arrDati(t, i) = vTmp4
arrDati(t, j) = vTmp3
Next t
End If
ElseIf SortOrder = xlDescending Then ' dal più grande al più piccolo
If vTmp2 > vTmp1 Then
arrDatiRiga(1, i) = vTmp2
arrDatiRiga(1, j) = vTmp1
For t = 1 To .Rows.Count
vTmp3 = arrDati(t, i)
vTmp4 = arrDati(t, j)
arrDati(t, i) = vTmp4
arrDati(t, j) = vTmp3
Next t
End If
End If
End If ' vTmp1 <> "" And vTmp2 <> ""
Next j
Next i
End With ' Rng
OrdinamentoOrizzontaleIntervallo = arrDati
End Function


C'è una annotazione da fare nel caso di ordinamento di stringhe di testo con l'opzione "MatchCase" (Maiuscole/Minuscole).
L'ordinamento di VBA è differente da quello da interfaccia utente in Excel.

In VBA "A" viene prima di "a".
Con l'ordinamento con le funzioni Excel invece "a" viene prima di "A".
E di questa cosa eventualmente occorre tenerne consto nel caso possa avere rilevanza per i dati trattati.

ciao

[Bruno Campanini]

Post by Bruno Campanini
A proposito della tua ottima procedura RIcercaAmbi ho provato a
riscrivere la mia da 45 minuti utilizzando Dictionary: niente da fare
la ricerca dell'ambo nella sestina si fa in un lampo
(If D.Exists(Ambo1) And D.Exists(Ambo2) etc), però caricare una
singola sestina per volta nel dizionario costa parecchio tempo.
Non sono riuscito a ottenere i risultati giusti in meno di 5 minuti.
Allora ho provato con gli array seguendo la tua logica ma usando range
anziché tabelle. Il tempo si è ridotto a meno di 3 minuti
(un'esagerazione in rapporto alla tua manciata di secondi).
- le tue tabelle vs i miei range
- il fatto che tu risolvi il problema solo se gli ambi e le
sestine sono ordinati crescenti per riga da sinistra a destra
(io invece risolvo il tutto ancorché disordinato)
For y = t + 1 To UBound(arrEstrazioni, 2) e a riscrivere un ambo
da 15-25 a 25-15: il tempo semplicemente raddoppia (23") e i risultati
sono quelli giusti.
Tutta la differenza sta in Tables vs Ranges?

Sono arrivato anch'io, seguendo la tua impostazione e qualche piccolo
ritocco. Tempo 10.5"

Ciò dopo aver fatto la versione Access (Tempo 20") che pensavo
sarebbe stata più veloce usando una query.
Ma non sono stato in grado di farla quella query né il NG
interpellato è riuscito al riguardo.

https://1drv.ms/x/s!AvTaMfd5-b2oz1PmlpNH-6Qlhzyc?e=ecJIi9

Bruno

[casanmaner]

Ciao Bruno,
ho analizzato le tue modifiche.
Provando la tua routine sia nel tuo file originario (senza le tabelle) che nel mio (con le tabelle) il tempo di esecuzione con il mio pc è di quasi 15"
Nella mia procedura ho quindi modificato i cicli in modo che le sestine vengano passate in tutte e 6 le colonne (in precedenza io mi fermavo per il primo elemento dell'ambo a -1 e per il secondo elemento dell'ambo iniziavo da +1 rispetto al ciclo della colonna precedente).
E questo ovviamente ha comportato un aumento dei tempi. Nel mio pc da 20" a 29".
Poi ho inserito l'Exit For una volta trovata la corrispondenza degli ambi. Il vantaggio è meno di 1".
Mi sono chiesto quale fosse la differenza di quasi 15".
Ho poi notato che tu hai dichiarato le variabili:
Ambi(), Sestine()
con l'indicazione delle parentesi.

Ho allora provato a dichiarare le mie omologhe variabili
Dim ArrAmbi() As Variant
Dim arrEstrazioni() As Variant
(prima erano dichiarate senza le parentesi)
e magia il tempo di esecuzione è sceso a quasi 12" con il mio pc.
Questa cosa ricordo di averla notata già molto tempo fa per un'altra procedura che elaborava moltissimi dati.
In altre occasioni invece mi era capitato che i tempi rallentassero.
Mi devo ricordare in futuro di fare sempre due test di confronto con una dichiarazione o l'altra :)

Qui il link al file dove con il pulsante 1 si attiva la mia procedura e con il 2 la tua procedura (dove per guadagnare un mezzo secondo ho spostato la riga di cancellazione dei dati di colonna c sotto la disabilitazione dello schermo e del ricalcolo):
https://www.dropbox.com/s/vzaq332u8hs4hx6/Ricerca%20Ambi%20Bruno%201.xlsm?dl=0

Se vuoi prova con il tuo pc per verificare i tempi (a parte il fatto che dovrò proprio prendere un pc nuovo :) )

[Bruno Campanini]

Post by ***@gmail.com
Ciao Bruno,
ho analizzato le tue modifiche.
Provando la tua routine sia nel tuo file originario (senza le tabelle) che
nel mio (con le tabelle) il tempo di esecuzione con il mio pc è di quasi 15"
Nella mia procedura ho quindi modificato i cicli in modo che le sestine
vengano passate in tutte e 6 le colonne (in precedenza io mi fermavo per il
primo elemento dell'ambo a -1 e per il secondo elemento dell'ambo iniziavo da
+1 rispetto al ciclo della colonna precedente). E questo ovviamente ha
comportato un aumento dei tempi. Nel mio pc da 20" a 29". Poi ho inserito
l'Exit For una volta trovata la corrispondenza degli ambi. Il vantaggio è
meno di 1". Mi sono chiesto quale fosse la differenza di quasi 15". Ho poi
notato che tu hai dichiarato le variabili: Ambi(), Sestine() con
l'indicazione delle parentesi.
Ho allora provato a dichiarare le mie omologhe variabili
Dim ArrAmbi() As Variant
Dim arrEstrazioni() As Variant
(prima erano dichiarate senza le parentesi)
e magia il tempo di esecuzione è sceso a quasi 12" con il mio pc.
Questa cosa ricordo di averla notata già molto tempo fa per un'altra
procedura che elaborava moltissimi dati. In altre occasioni invece mi era
capitato che i tempi rallentassero. Mi devo ricordare in futuro di fare
sempre due test di confronto con una dichiarazione o l'altra :)

Se io tolgo () ad Ambi e Sestine passo da 10.5 a 20... incredibile!

Post by ***@gmail.com
Qui il link al file dove con il pulsante 1 si attiva la mia procedura e con
il 2 la tua procedura (dove per guadagnare un mezzo secondo ho spostato la
riga di cancellazione dei dati di colonna c sotto la disabilitazione dello
schermo e del ricalcolo)

[C:C].ClearContents... dove lo metto lo metto non cambia nulla.
L'ho messo fuori perché vorrei vedere la cancellazione dei vecchi dati
e l'inserimento dei nuovi (anche l'occhio vuol la sua), ma detta
cancellazione avviene una volta sì e 10 no: con maggior frequenza
se attivo la procedura dal RUN della finestra VBA.

Post by ***@gmail.com
https://www.dropbox.com/s/vzaq332u8hs4hx6/Ricerca%20Ambi%20Bruno%201.xlsm?dl=0
Se vuoi prova con il tuo pc per verificare i tempi (a parte il fatto che
dovrò proprio prendere un pc nuovo :) )

In 5 operazioni la tua procedura impiega mediamente 17.5 secondi.
Non saprei il motivo della differenza, mi resta solo da pensare
al fatto che tu raccogli la colonna risultati nella terza colonna
dell'array Ambi (ArrAmbi(i, 3)) che poi ricopi tutto ArrAmbi
sulle tre colonne della tabella Ambi.
Io invece raccolgo i dati in un vettore NumAmbi(1 To 4005) che poi
ricopio sulla prima colonna a destra del range Ambi.
Quindi nell'operazione fiinale dovre impiegare 1/3 del tuo tempo.

Ma stiamo discutendo di lana caprina... l'OP impiegava 2 ore,
io a tutto Range 45', ora esaminiamo i secondi e i loro decimi!

Io uso un i7 di 3° generazione con 32 GRam, ora siamo prossimi
all'i7 di 11° a all'i9 che ancora non si sa bene se giunto alla
versione definitiva... e costa quasi un milione :-) :-) :-)

In materia di Covid, tanto per non trascurare l'attuale
principale argomento delle discussioni, io sono in ER da domani
arancione, tu di che colore sei?

Bruno

[Bruno Campanini]

Post by Bruno Campanini
Ma stiamo discutendo di lana caprina... l'OP impiegava 2 ore,
io a tutto Range 45', ora esaminiamo i secondi e i loro decimi!
Io uso un i7 di 3° generazione con 32 GRam, ora siamo prossimi
all'i7 di 11° a all'i9 che ancora non si sa bene se giunto alla
versione definitiva... e costa quasi un milione :-) :-) :-)

Il tuo file l'ho provato nel PC di mio figio (i7 8° generazione
che funziona a scartamento ridotto di 1.9 GHz),
la tua procedura 16", la mia 21".

Ho riprovato in Access, senza nulla modificare, oggi 10.5"
anziché 20" di alcuni giorni fa.

È tutto da ridere!

Bruno

PS
Tanto per passare il tempo... proviano a testare, sulle sestine che
già abbiamo, i 117480 terni???

[casanmaner]

Post by Bruno Campanini
Se io tolgo () ad Ambi e Sestine passo da 10.5 a 20... incredibile!

Sì, incredibile.
Probabilmente l'indicazione della variabile con le parentesi fa riconoscere tale variabile subito come matrice con migliore allocazione delle risorse di memoria.

Post by Bruno Campanini
In 5 operazioni la tua procedura impiega mediamente 17.5 secondi.
Non saprei il motivo della differenza, mi resta solo da pensare
al fatto che tu raccogli la colonna risultati nella terza colonna
dell'array Ambi (ArrAmbi(i, 3)) che poi ricopi tutto ArrAmbi
sulle tre colonne della tabella Ambi.
Io invece raccolgo i dati in un vettore NumAmbi(1 To 4005) che poi
ricopio sulla prima colonna a destra del range Ambi.
Quindi nell'operazione fiinale dovre impiegare 1/3 del tuo tempo.

Con il mio PC uso Excel 2007.
E a differenza tua ottengo con la mia procedura mediamente 11,9" e con la tua 14,9".
Quindi da me la mia risulta addirittura più veloce della tua.
Credo che la differenza sia proprio nella versione di Excel.
Ad essere sincero già utilizzando Excel 2013 o 2016 ho notato che alcune procedure che con Excel 2007 risultavano più veloci con le versioni successive invece risultavano, anche sensibilmente, più lente al punto di modificare in modo che fossero più veloci con le versioni più recenti (perché era minore la differenza in più con Excel 2007 che la differenza in meno ottenuta con le modifiche con Excel 2013/2016).
Non sono mai riuscito a darmi una spiegazione.

Post by Bruno Campanini
Ma stiamo discutendo di lana caprina... l'OP impiegava 2 ore,
io a tutto Range 45', ora esaminiamo i secondi e i loro decimi!

Sì sì direi che da 2 ore a 10", 15", 20" c'è un abisso e ci si può accontentare anche di 20" alla peggio :)

Post by Bruno Campanini
all'i9 che ancora non si sa bene se giunto alla
versione definitiva... e costa quasi un milione :-) :-) :-)

Ok, visto il costo ... aspetto che arrivino almeno alla II^ :D :D

Post by Bruno Campanini
In materia di Covid, tanto per non trascurare l'attuale
principale argomento delle discussioni, io sono in ER da domani
arancione, tu di che colore sei?

Mi aspettavo che il Veneto passasse arancione ma è rimasto giallo.
Sarà perché le strutture sanitarie reggono perché se guardiamo ai contagi rispetto ai casi testati i numeri sono alti (magari perché i test li fanno a "colpo sicuro", cioè dove sanno che ci sono focolai).
Mah?

[[e-mail]]

Post by casanmaner

Post by Bruno Campanini
procedura non me lo consente (Formula->Name Manager...), perché?

Forse ho capito.
I nomi delle tabelle e i riferimenti non possono essere modificati da Formula->Gestione nomi.
Devi andare nella tab "Progettazione" che appare quando selezioni una tabella.
ciao

Ciao Grazie per la macro.
ho lasciato stare la Tabella1 quella degli ambi, tanto normalmente le estrazioni sono molte, quindi ho preferito lasciare tutte le combinazioni degli ambi, se non ce riscontro riporterà 0 come trovato

ma il problema con la Tabella2, fintanto che i record aumentano non ce problema ma se i record diminuiscono la macro non ridimensiona la tabella ma resta la dimensione precedente.

quindi ho dovuto trovare un modo per ridimensionare la Tabella2 sia se aumentano che diminuiscono

ho aggiunto queste righe nella macro

Righe aggiunte -----------------------------------------------------
Dim sh As Worksheet
Set sh = Worksheets("RicercheSenzaparametri&date")
i = sh.Cells(Rows.Count, 5).End(xlUp).Row
With sh
.ListObjects("Tabella2").Resize .Range("E1").Offset(0, 0).Resize(i, 6)
End With
fine righe aggiunte ------------------------------------------------- prima di

With ThisWorkbook
With .Worksheets("RicercheSenzaparametri&date")
Set oLo1 = .ListObjects("Tabella1")
Set oLo2 = .ListObjects("Tabella2")
End With
End With

In questo modo ridimensiono la tabella perche i nuovi record vengono cancellati ed incollati ed avevo appunto il ridimensionamento della Tabella2



Ciao e grazie per la macro

[casanmaner]

Post by ***@gmail.com

Post by casanmaner

Post by Bruno Campanini
procedura non me lo consente (Formula->Name Manager...), perché?

Forse ho capito.
I nomi delle tabelle e i riferimenti non possono essere modificati da Formula->Gestione nomi.
Devi andare nella tab "Progettazione" che appare quando selezioni una tabella.
ciao

Ciao Grazie per la macro.
ho lasciato stare la Tabella1 quella degli ambi, tanto normalmente le estrazioni sono molte, quindi ho preferito lasciare tutte le combinazioni degli ambi, se non ce riscontro riporterà 0 come trovato
ma il problema con la Tabella2, fintanto che i record aumentano non ce problema ma se i record diminuiscono la macro non ridimensiona la tabella ma resta la dimensione precedente.
quindi ho dovuto trovare un modo per ridimensionare la Tabella2 sia se aumentano che diminuiscono
ho aggiunto queste righe nella macro
Righe aggiunte -----------------------------------------------------
Dim sh As Worksheet
Set sh = Worksheets("RicercheSenzaparametri&date")
i = sh.Cells(Rows.Count, 5).End(xlUp).Row
With sh
.ListObjects("Tabella2").Resize .Range("E1").Offset(0, 0).Resize(i, 6)
End With
fine righe aggiunte ------------------------------------------------- prima di
With ThisWorkbook
With .Worksheets("RicercheSenzaparametri&date")
Set oLo1 = .ListObjects("Tabella1")
Set oLo2 = .ListObjects("Tabella2")
End With
End With
In questo modo ridimensiono la tabella perche i nuovi record vengono cancellati ed incollati ed avevo appunto il ridimensionamento della Tabella2
Ciao e grazie per la macro

Ciao non avevo inteso che servisse ridimensionare la seconda tabella.
Per semplificare il codice potresti utilizzare questa istruzione:

With oLo2
.Resize .Range.CurrentRegion
arrEstrazioni = .DataBodyRange.Value
End With

andrebbe inserita al posto dell'istruzione:
arrEstrazioni = oLo2.DataBodyRange.Value

In questo modo è tutto legato alla posizione della tabella e non è necessario inserire nel vba la riga da cui partono le intestazioni.
Prova e vedi se funziona correttamente con i tuoi dati.

ciao

[Bruno Campanini]

Post by ***@gmail.com

Post by casanmaner

Post by Bruno Campanini
procedura non me lo consente (Formula->Name Manager...), perché?

Forse ho capito.
I nomi delle tabelle e i riferimenti non possono essere modificati da
Formula->Gestione nomi.
Devi andare nella tab "Progettazione" che appare quando selezioni una tabella.
ciao

Ciao Grazie per la macro.
ho lasciato stare la Tabella1 quella degli ambi, tanto normalmente le
estrazioni sono molte, quindi ho preferito lasciare tutte le combinazioni
degli ambi, se non ce riscontro riporterà 0 come trovato
ma il problema con la Tabella2, fintanto che i record aumentano non ce
problema ma se i record diminuiscono la macro non ridimensiona la tabella ma
resta la dimensione precedente.

Dim R As Range
Set R = Range([Sheet5!A1], [Sheet5!A1].End(xlDown).End(xlToRight))

Se fai così l'automatismo è perfetto.

Bruno