feed
top
crea forum
cerca
feed
forum
supporto
discussione
cerca
Stellar Blade
Un'esclusiva
PS5
che sta facendo discutere per l'eccessiva bellezza della protagonista. Vieni a parlarne su
Award & Oscar!
Excel Forum
Per condividere esperienze su Microsoft Excel
Cerca
Soluzioni Excel Domande e Risposte
Accedi
qualcuno può aiutarmi con questa macro
Messaggi
OFF
LINE
alessio del regno
Post: 1
Registrato il: 31/05/2023
Età: 27
Utente Junior
2304
0
0
31/05/2023
12:14
qualcuno potrebbe aiutarmi con questa macro, non mi funziona e non riesco a capire qual è il problema
Function CalcolaDistanza(lat1 As Double, lon1 As Double, lat2 As Double, lon2 As Double) As Double
Const R As Double = 6371 ' Raggio medio della Terra in chilometri
Dim dLat As Double
Dim dLon As Double
Dim a As Double
Dim c As Double
Dim d As Double
' Conversione da gradi a radianti
lat1 = WorksheetFunction.Radians(lat1)
lon1 = WorksheetFunction.Radians(lon1)
lat2 = WorksheetFunction.Radians(lat2)
lon2 = WorksheetFunction.Radians(lon2)
' Calcolo delle differenze di latitudine e longitudine
dLat = lat2 - lat1
dLon = lon2 - lon1
' Calcolo della distanza utilizzando la formula di Haversine
a = Sin(dLat / 2) ^ 2 + Cos(lat1) * Cos(lat2) * Sin(dLon / 2) ^ 2
c = 2 * WorksheetFunction.Atan2(Sqr(a), Sqr(1 - a))
d = R * c
CalcolaDistanza = d
End Function
Sub macro_ottimizzazione()
Sheets("COORDINATE DONATORI").Select
Dim numPunti As Integer
Dim numFurgoncini As Integer
Dim coordPunti As Range
Dim coordFurgoncini As Range
Dim distanzaMax As Double
numPunti = WorksheetFunction.CountA(Range("B3:B122")) - 1 ' Numero di punti dati (escludendo l'intestazione)
numFurgoncini = 0 ' Numero iniziale di furgoncini
Set coordPunti = Range("C3:D" & numPunti + 2) ' Range delle coordinate dei punti dati
distanzaMax = 3 ' Distanza massima consentita in km
' Calcola la distanza tra tutti i punti e assegna i furgoncini
Do While numPunti > 0
numFurgoncini = numFurgoncini + 1 ' Incrementa il numero di furgoncini
Set coordFurgoncini = Range("G3:H" & numFurgoncini + 2) ' Range delle coordinate dei furgoncini
' Calcola la distanza tra i punti e i furgoncini e assegna i furgoncini ai punti più vicini
For Each punto In coordPunti
minDistanza = distanzaMax
For Each furgoncino In coordFurgoncini
distanza = CalcolaDistanzaEuclidea(punto, furgoncino)
If distanza < minDistanza Then
minDistanza = distanza
punto.Offset(0, 2).Value = furgoncino.Offset(0, 2).Value ' Assegna l'etichetta del furgoncino al punto
End If
Next furgoncino
Next punto
numPunti = WorksheetFunction.CountIf(Range("E3:E122"), "") ' Conta i punti non assegnati a un furgoncino
Loop
End Sub
Function CalcolaDistanzaEuclidea(coordPunti As Range, coordFurgoncini As Range) As Double
' Esempio: calcola la distanza euclidea tra due punti utilizzando le coordinate geografiche
Dim deltaX As Double
Dim deltaY As Double
deltaX = coordFurgoncini.Offset(0, -2).Value - coordPunti.Offset(0, -2).Value ' Calcola la differenza tra le coordinate X
deltaY = coordFurgoncini.Offset(0, -1).Value - coordPunti.Offset(0, -1).Value ' Calcola la differenza tra le coordinate Y
CalcolaDistanzaEuclidea = Sqr(deltaX ^ 2 + deltaY ^ 2) ' Calcola la distanza euclidea utilizzando il teorema di Pitagora
End Function
OFF
LINE
rollis13
Post: 1.335
Registrato il: 16/08/2015
Città: CORDENONS
Età: 67
Utente Veteran
Excel 2016-32bit Win11
0
0
31/05/2023
18:13
Re:
non mi funziona
E dovremmo noi capire cosa non funziona ?! almeno spiega qual è l'obiettivo del progetto, come si usa la macro ed in base a cosa affermi che non funziona oltre a specificare, se è la macro che si interrompe, a quale riga e con quale diagnostica.
Ps. e nemmeno si pretende un esempio di file ridotto al minimo (poche righe di dati) e senza dati sensibili.
[
Modificato da rollis13 31/05/2023 18:21
]
______________________________________________________________
C'è chi fa le COSE a CASO e chi fa CASO alle COSE (Ignoto)
OFF
LINE
tanimon
Post: 1.578
Registrato il: 27/06/2011
Utente Veteran
excel 2007
0
0
31/05/2023
21:32
ciao,
bella domanda.....
Scusami tanto,
ma questa sera sono stranamente di buon umore.....
Non è che potrei avere una domanda di riserva od un aiutino....?!?!?!?
🤣🤣🤣🤣🤣
Buona serata
Frank
Stretta la foglia, larga la via, dite la vostra che ho detto la mia.
Excel 2007 forse anche 2013 ... 2021 ... 365 e future...
Tag discussione
qualcuno
macro
Registrati
Accedi
Soluzioni Excel Domande e Risposte
Accedi
IL MIO PROFILO
LE MIE DISCUSSIONI
FORUM CHE SEGUI
LA MIA FORUM-CARD
MODIFICA FORUM-CARD
FAQ
TRADUCI
LOGOUT
Accedi
Registrati
FAQ
TRADUCI
Scatta o carica foto
Allega file
Inserisci link da url (card)
Incorpora url (YouTube/Twitter/...)
ACCETTA
RIFIUTA
Anteprima