Il problema dei 3 corpi: Attraverso continenti e decadi, cinque amici geniali fanno scoperte sconvolgenti mentre le leggi della scienza si sgretolano ed emerge una minaccia esistenziale. Vieni a parlarne su TopManga.
 
Previous page | 1 | Next page
Vote | Print | Email Notification    
Author

COLLEGAMENTO CELLE CON LINEE AUTOMATICHE

Last Update: 2/26/2024 10:09 AM
Post: 15
Registered in: 1/2/2012
Location: NAPOLI
Age: 65
Junior User
EXCEL 2019
OFFLINE
2/24/2024 9:49 AM
 
Modify
 
Delete
 
Quote

Buongiorno a tutti.Ho la necessità di rendere in automatico quanto segue:ho una griglia ( allegato) dove ogni estrazione collego i numeri estratti con il comando INSERISCI-FORME-FRECCIA. Formando in questo modo una sorta di ragnatela.Si può automatizzare con qualche comando il tutto? Considerando che ogni estrazione i numeri cambiano e quindi si ottiene una nuova ragnatela? Chiaramente potrei anche scrivere solo i numeri nuovi sortiti e il programma farebbe la sua parte. Grazie.
Post: 1,162
Registered in: 4/2/2018
Location: PESCARA
Age: 75
Veteran User
EXCEL 2016 - SPREAD32
OFFLINE
2/24/2024 9:53 AM
 
Modify
 
Delete
 
Quote

ciao
ti trovi nella sezione che serve SOLO a presentarsi
i quesiti si pongono nella sezione Domande e Risposte
quindi per favore vai in quella sezione e ripeti la tua richiesta

https://www.freeforumzone.com/a/167685/Domande-e-risposte-Soluzioni-Excel/cartella.aspx

Grazie
[Edited by L2018 2/24/2024 10:04 AM]

LEO
https://t.me/LordBrum
Post: 7,546
Registered in: 11/14/2004
Master User
Office 2019
OFFLINE
2/24/2024 10:07 AM
 
Modify
 
Delete
 
Quote

Ciao ma poi la ragnatela partirebbe sempre dal numero 1, oltretutto la sequenza dei numeri dovrebbe essere ordinata in crescendo? oppure secondo l'uscita?.

Ciao By Sal (8-D
se ti piace la soluzione sostienici con una DONAZIONE a piacere. Grazie clicca qui
Post: 15
Registered in: 1/2/2012
Location: NAPOLI
Age: 65
Junior User
EXCEL 2019
OFFLINE
2/24/2024 12:49 PM
 
Modify
 
Delete
 
Quote

Secondo l'uscita e partendo dal numero più piccolo al più grande.
Post: 3,749
Registered in: 4/6/2013
Master User
2010
OFFLINE
2/24/2024 1:08 PM
 
Modify
 
Delete
 
Quote

ciao
QUI hai la soluzione...con poco da adattare

saluti




Domenico
Win 10 - Excel 2016
Post: 16
Registered in: 1/2/2012
Location: NAPOLI
Age: 65
Junior User
EXCEL 2019
OFFLINE
2/24/2024 1:50 PM
 
Modify
 
Delete
 
Quote

COLLEGAMENTO CELLE CON LINEE AUTOMATICHE
PER dodo47
Grazie per la soluzione,scusa la mia incompetenza,ma la soluzione la devo incollare in excel e poi SVILUPPO VISUAL BASIC ?
GRAZIE
SALUTI
Post: 3,750
Registered in: 4/6/2013
Master User
2010
OFFLINE
2/24/2024 2:30 PM
 
Modify
 
Delete
 
Quote

...ho capito

Questi i codici contenuti nell'allegato
Dim mFrom As Range, mTo As Range, extr As Integer, mTab As Range
Dim Rng1 As Range, Rng2 As Range
Set mTab = Range("A1:J9")
For Each cn In ActiveSheet.Shapes
    If cn.Type = 1 Then cn.Delete
Next
For extr = 14 To 17
    Set mFrom = Cells(1, extr)
    Set mTo = Cells(1, extr + 1)
    With mTab
        Set Rng1 = .Find(mFrom.Value, LookIn:=xlValues, lookat:=xlWhole)
        Set Rng2 = .Find(mTo.Value, LookIn:=xlValues, lookat:=xlWhole)
        If Rng1 Is Nothing Or Rng2 Is Nothing Then Exit Sub
        Call DrawArrows(Rng1, Rng2, , "Line")
    End With
Next extr
Range("A1").Select
End Sub

Private Sub DrawArrows(FromRange As Range, ToRange As Range, Optional RGBcolor As Long, Optional LineType As String)
'---------------------------------------------------------------------------------------------------
'---Script: DrawArrows------------------------------------------------------------------------------
'---Created by: Ryan Wells -------------------------------------------------------------------------
'---Date: 10/2015-----------------------------------------------------------------------------------
'---Description: This macro draws arrows or lines from the middle of one cell to the middle --------
'----------------of another. Custom endpoints and shape colors are suppported ----------------------
'---------------------------------------------------------------------------------------------------

Dim dleft1 As Double, dleft2 As Double
Dim dtop1 As Double, dtop2 As Double
Dim dheight1 As Double, dheight2 As Double
Dim dwidth1 As Double, dwidth2 As Double
dleft1 = FromRange.Left
dleft2 = ToRange.Left
dtop1 = FromRange.Top
dtop2 = ToRange.Top
dheight1 = FromRange.Height
dheight2 = ToRange.Height
dwidth1 = FromRange.Width
dwidth2 = ToRange.Width
 
ActiveSheet.Shapes.AddConnector(msoConnectorStraight, dleft1 + dwidth1 / 2, dtop1 + dheight1 / 2, dleft2 + dwidth2 / 2, dtop2 + dheight2 / 2).Select
'format line
With Selection.ShapeRange.Line
    .BeginArrowheadStyle = msoArrowheadNone 'xxx
    .EndArrowheadStyle = msoArrowheadOpen 'xxx
    .Weight = 1.75
End With
 
End Sub


saluti




Domenico
Win 10 - Excel 2016
Post: 7,547
Registered in: 11/14/2004
Master User
Office 2019
OFFLINE
2/24/2024 3:33 PM
 
Modify
 
Delete
 
Quote

Ciao vedi se va bene, una macro che avevo fatto anni fa per una simulazione dei passaggi nel calcio, l'ho adattata al tuo schema.

puoi inserire fino a 5 estrazioni, questa un immagine



basta inserire le estrazioni e cliccare sulla freccia il pulsante rosso cancella tutte le frecce, la cella verde è il numero di partenza dell'estrazione

Ciao By Sal (8-D

P.S. ma per curiosità a cosa ti serve vedere la sequenza dei numeri con le frecce?

[Edited by by sal 2/25/2024 7:57 AM]
se ti piace la soluzione sostienici con una DONAZIONE a piacere. Grazie clicca qui
Post: 17
Registered in: 1/2/2012
Location: NAPOLI
Age: 65
Junior User
EXCEL 2019
OFFLINE
2/25/2024 9:23 AM
 
Modify
 
Delete
 
Quote

COLLEGAMENTO CELLE CON LINEE AUTOMATICHE
BUONGIORNO
Rispondo a BY SAL E DODO 47.Con grande professionalità mi hanno dato la soluzione al mio quesito.
Chiedo solo: la macro da voi fornita collega solo 5 punti ( già è una grande cosa),nel mio caso devo collegare 6 punti.
Se mi dite che posso apportare delle modifiche nel VBA ( non sò se ci riuscirei),non mi resta che chiedervi un ulteriore impegno.
Grazie sempre per la vostra disponibilità.

P.S. Per BY SAL che mi ha chiesto a cosa mi serve tutto questo. E' una visione di osservare il comportamento delle uscite dei numeri in una griglia vuota,
Potrò rispondere alla tua domanda quando avrò finito, di analizzare tutte le estrazioni dell'Enalotto dal 1997.
Per ora è solo una ipotesi.
Ancora Grazie
P.S. Aspetto la modifica
Post: 1,165
Registered in: 4/2/2018
Location: PESCARA
Age: 75
Veteran User
EXCEL 2016 - SPREAD32
OFFLINE
2/25/2024 9:40 AM
 
Modify
 
Delete
 
Quote

ciao
nella macro di Dodo47 ( che ringrazio e saluto) compare all'inizio questo rigo

For extr = 14 To 17

basta cambiare il 17 in 18, e ovviamente nel foglio bisogna inserire un sesto numero

Possiamo notare anche che aumentando il 17 a 18 e anche più, e mettendo altri numeri nel rigo degli estratti, la freccia risultante si allunga, e cioè

continua a funzionare

Dodo47 mi scuserà se mi sono permesso di esercitarmi
[Edited by L2018 2/25/2024 9:47 AM]

LEO
https://t.me/LordBrum
Post: 7,549
Registered in: 11/14/2004
Master User
Office 2019
OFFLINE
2/25/2024 9:54 AM
 
Modify
 
Delete
 
Quote

Ciao questa la mia macro modificata

Sub prova()
Dim quadro, spie
Dim r, c, c1, c2, d, x, y, z, clr, Ind1, ind2, T1, T2, L1, L2

If CL = "" Then CL = 1
If CL = 5 Then CL = 1
spie = Range("L2:Q6")
Set quadro = Range("A1:J9")
For z = 1 To UBound(spie)
  clr = RGB(0, 0, 0)
  If spie(z, 1) = "" Then Exit For
  For x = 1 To 5
    c1 = spie(z, x)
    c2 = spie(z, x + 1)
    For Each y In quadro
      d = y.Value
      If c1 = y.Value Then Ind1 = y.Address
      If c2 = y.Value Then ind2 = y.Address
    Next y
    T1 = Range(Ind1).Top + 12
    L1 = Range(Ind1).Left + 12
    T2 = Range(ind2).Top + 12
    L2 = Range(ind2).Left + 12
    ActiveSheet.Shapes.AddConnector(msoConnectorStraight, L1, T1, L2, T2).Select
    Selection.ShapeRange.Line.EndArrowheadStyle = msoArrowheadOpen
    Selection.ShapeRange.Line.ForeColor.RGB = clr
    Selection.ShapeRange.Line.Weight = 0.05
  Next x
Next z
Cells(1, 12).Select
End Sub


ho messo 1 solo colore ho aggiunto un numero colonna "Q", ora sono 6 che devi inserire, ed ho assottigliato lo spessore della freccia, anche se sono convinto che alla fine avrai solamente tutti i numeri coperti e non vedrai un bel niente vista la mole di estrazioni che inserirai, visto che saranno coperti tutti i 90 numeri.
per inserire tutto il range di estrazioni devi variare questa riga

spie = Range("L2:Q6")

con il range delle estrazioni

Ciao By Sal (8-D


[Edited by by sal 2/25/2024 10:52 AM]
se ti piace la soluzione sostienici con una DONAZIONE a piacere. Grazie clicca qui
Post: 7,550
Registered in: 11/14/2004
Master User
Office 2019
OFFLINE
2/25/2024 10:57 AM
 
Modify
 
Delete
 
Quote

Ciao Come volevasi dimostrare ecco un esempio del risultato

questa dal 1997



questa invece dal 2020



questa 2023-2024



questa del 2024



non so cosa riuscirai a ricavarne, visto che avevo il file e gli archivi ho fatto le proiezioni

Ciao By Sal (8-D
se ti piace la soluzione sostienici con una DONAZIONE a piacere. Grazie clicca qui
Post: 18
Registered in: 1/2/2012
Location: NAPOLI
Age: 65
Junior User
EXCEL 2019
OFFLINE
2/25/2024 2:42 PM
 
Modify
 
Delete
 
Quote

COLLEGAMENTO CELLE CON LINEE AUTOMATICHE
Buongiorno
Siete stati eccezionali,ho apportato le vostre modifiche,è quello che volevo.
Ho visto l'aggiunta di By Sal,apprezzo molto il risultato,ma io quello che mi voglio ottenere è questo ( allego file di esempio),ogni estrazione rappresenta un suo disegno unico,nella sua unicità avrà la sua conformità. E' una mia tesi ( da dimostrare), una volta finito il lavoro,devo trovare una soluzione tramite l'apporto dell'intelligenza artificiale o se c'è un altro sistema,che analizzi in pochi secondi,tutte queste figure.
E poi chissà cosa ne verrà fuori...
Poi se c'è una soluzione sftware o un algoritmo, che analizzi tutte le estrazioni del superenalotto dal 1997.
Seguendo questo ( rudimentale algoritmo):
1) PREPARA UNA GRIGLIA CON 90 NUMERI SUDDIVISA PER 10 COLONNE E 9 RIGHE
2) STAMPA I NUMERI NELL'ORDINE DA DESTRA VESRO SINISTRA IN MODO CRESCENTE.
3) PRENDI LA PRIMA ESTRAZIONE N°1 E DISEGNA UNENDO CON UNA LINEA I NUMERI SORTITI DAL PIU' PICCOLO AL PIU GRANDE.
4)RIPETI IL PUNTO 3 CON TUTTE LE ESTRAZIONI SUCCESSIVE ALLA NUMERO 1
5) FINE
Ripeto è solo un primitivo e rudimentale algoritmo, giusto per dare una indicazione.
Grazie di cuore a tutti.
Post: 3,752
Registered in: 4/6/2013
Master User
2010
OFFLINE
2/25/2024 5:33 PM
 
Modify
 
Delete
 
Quote

ciao
non so nulla di lotto e/o superenalotto (e non ne voglio saper nulla)....

Tieni presente che il formato da te applicato (;;;) impedisce alla "mia" macro di funzionare in quanto il find fallisce.
Pertanto se ci vuoi provare, dai il colore bianco ai numeri e togli quel formato così come ho fatto nell'allegato.

1000 estrazioni (che non so a quanto tempo corrispondano) nel mio pc impiegano circa 35 sec. e, naturalmente, occupano fino alla riga 9000.

La serie 1->90 deve essere ovviamente ripetuta nelle prime 10 colonne finchè serve, in quanto al codice serve trovarli per mostrare le linee

Nell'allegato sono ripetuti per circa 15.000 righe e non ho idea di quante ce ne servano....conta che ogni estrazione necessita di 9 righe e il totale righe è poco più di 1.000.000

Ringrazio Leo per l'intervento.....

Questo il codice corretto

saluti

Sub mStart()
Dim mFrom As Range, mTo As Range, extr As Integer, mTab As Range
Dim Rng1 As Range, Rng2 As Range, xTab As Long, yTab As Long
xTab = 1
yTab = 9
t = Time

For Each cn In ActiveSheet.Shapes
    If cn.Type = 1 Then cn.Delete
Next
For i = 1 To 1000
    For extr = 14 To 18
        Set mTab = Range("A" & xTab & ":J" & yTab)
        Set mFrom = Cells(i, extr)
        Set mTo = Cells(i, extr + 1)
        With mTab
            Set Rng1 = .Find(mFrom.Value, LookIn:=xlValues, lookat:=xlWhole)
            Set Rng2 = .Find(mTo.Value, LookIn:=xlValues, lookat:=xlWhole)
            If Rng1 Is Nothing Or Rng2 Is Nothing Then Exit Sub
            Call DrawArrows(Rng1, Rng2, , "Line")
        End With
    Next extr
    xTab = xTab + 9
    yTab = yTab + 9
Next i
Range("A1").Select
MsgBox Format(Time - t, "hh:mm:ss")
End Sub
[Edited by dodo47 2/25/2024 6:16 PM]
Domenico
Win 10 - Excel 2016
Post: 19
Registered in: 1/2/2012
Location: NAPOLI
Age: 65
Junior User
EXCEL 2019
OFFLINE
2/25/2024 10:42 PM
 
Modify
 
Delete
 
Quote

COLLEGAMENTO CELLE CON LINEE AUTOMATICHE
Buonasera
Ho provato il file che mi hai inviato,per me è come se fosse uscito il genio dalla lampada di Aladino.
Lo sò non è magia ma competenza,professionalità,impegno e passione.Solo così si ottengono dei risultati.
Adesso tocca a me impegnarmi.
Grazie mille Dodo47 e anche agli altri collaboratori.
Alla prossima.
Post: 3,754
Registered in: 4/6/2013
Master User
2010
OFFLINE
2/26/2024 10:09 AM
 
Modify
 
Delete
 
Quote

grazie a te per il riscontro

saluti




Domenico
Win 10 - Excel 2016
Vote: 15MediaObject5.00216 2
Admin Thread: | Close | Move | Delete | Modify | Email Notification Previous page | 1 | Next page
New Thread
 | 
Reply
Feed | Forum | Bacheca | Album | Users | Search | Log In | Register | Admin
Tutti gli orari sono GMT+01:00. Adesso sono le 6:26 PM. : Printable | Mobile | Regolamento | Privacy
FreeForumZone [v.6.1] - Copyright © 2000-2024 FFZ srl - www.freeforumzone.com