VBA problem...

Prøv at ligge koden ud så skal jeg se på det!

//>Rune

Sub lin105()
    Dim i As Byte
    Dim j As Byte
    Dim antal As Integer
    Dim a As Integer
    Dim count As Integer
    Dim min As Integer
    Dim val As Integer
    Dim minrow As Integer
           
    Worksheets("lin105").Range("A1").Activate
           
    Cells(1, 7) = "Rækkefølge"
    Cells(2, 7) = Cells(2, 1)
   
    a = 1
   
    'For j = 1 To 104
        For i = 1 To 104
            Cells(2 + i, 4) = ((Cells(2 + i, 2) - _
            Cells(1 + a, 2)) ^ 2 + (Cells(2 + i, 3) - _
            Cells(1 + a, 3)) ^ 2) ^ (0.5)
        Next
     
        min = 9999
        count = a + 1
       
        Do
            count = count + 1
            val = Cells(count, 4)
            If val < min Then
                min = val
                minrow = count
            End If
        Loop Until Cells(count + 1, 1) = "" _
        Or count > 9999
         
        Cells(2 + a, 7) = minrow
       
        Range("D3:d106").Clear
       
    'Next
   
End Sub

Nu fatter jeg overhovedet ikke VBA! -Men et lille tip (ved ik' hvor god du er til VB!)

For at få fat i den gamle værdi og "updatere" den med den nye værdig skriver du: streng = streng & "hej"

Eks:

(strStreng er lig med "dav" og strNew er lig med "hejj")
strStreng = strStreng & strNew
Dette vile give resultatet:
davhejj
!
Hvis så det er tal du skal ha' lagt til hinanden kan du gøre som følgende:
intTal1 = intTal1 + intTal2
så sætter den variablen intTal1 lig med intTal1 og plusser intTal1 med intTal2 så intTal1 bliver lig med intTal1 plus intTal2 !

//>Rune

Indlæs dine x og y værdier i et array Coor(14,1) -her antager jeg 15 punkter:

Coor(0,0) indeholder x1
Coor(0,1) indeholder y1
Coor(1,0) indeholder x2
Coor(1,1) indeholder y1
Coor(2,0) indeholder x3
Coor(2,1) indeholder y3
osv

Følgende kode finder den korteste afstand mellem 2 koordinater:

Dim Coor(14, 1), i, j, TempDist, Dist
   
For j = 0 To 14
    For i = 0 To 14
        If Not i = j Then
            TempDist = Sqr((Abs(Coor(j, 0) - Coor(i, 0)) ^ 2) + (Abs(Coor(j, 1) - Coor(i, 1)) ^ 2))
        End If
        If TempDist < Dist Then Dist = TempDist
    Next i
Next j

Dist vil nu indeholde den korteste afstand

Aha -jeg havde ikke set din egen kode; retter lige den til. ;-)

øhhhh, nu ikke gøre mig mere forviret end jeg er i forvejden...  ;-)

Jeg er kommet så langt som jeg skrev i ovenstående (min kode). Mit problem er ikke at finde den korteste afstand, men at sortere det nr fra der har den korteste afstand, og så generere nye afstande ud fra det nr man lige sorterede fra.

Jeg ved ikke om det er mig, der er dårlig til at forklare mig, men både medions' og tjacob's svar har slet ikke noget med det, jeg gerne vil frem til...

Pernille

OK Pernille ;-) Hvad mener du med at "generere nye afstande"?
Hvad er det du ønsker at finde? (slutresultat)

PS Du har i hvert fald en fejl i din kode:
Du bruger slet ikke j-loopet
Du kører blot i-loopet 104 gange

ah -det sidste passer ikke helt -så ikke ordentligt efter -sorry.

Jeg har 105 punkter. Først vil jeg finde afstanden fra punkt 1 ud til samtlige 104 andre punkter. Herefter vil jeg finde den mindste afstand(a). Nu skal jeg bruge dette punkts nummer(b) (altså ud for den mindste afstand(a)) og sætte over i en kolonne(c).

Nu skal jeg så finde afstanden fra det nye punkt (b) ud til samtlige andre punkter - undtagen til punkt 1, da denne er brugt i forvejen. Igen finde minimumsværdien og skrive punktets nummer i en kolonne(c).

Jeg skal blive ved indtil jeg har brugt alle 105 punkter og vil så have en liste med numre i den rækkefølge de forskellige punkter er blevet valgt.

Ang. j-loopet. Jeg ved godt jeg ikke har brugt det, men jeg skrev det da jeg regnede med at skulle bruge det til at lave denne løkke.

Pernille

OK -spørgsmålet er forstået ;-) Kigger på sagen (kan godt tage lidt tid; en time eller 2).

Ok. Jeg venter med længsel ;-)

OK pernille jeg har lavet en løsning:

Jeg kunne ikke helt overskue dine tal (og deres placering i arket), så jeg har lavet mit eget ark. Du skal derfor selv "oversætte", og rette dit regneark til. -Håber det er OK ;-)

Mit ark ligger her: http://home1.stofanet.dk/tonny/files/test1.zip

Hvis det er helt uoverskueligt, så send mig dit ark, så skal jeg rette det til -> tjacobat@hotmail.com


/tjacob

Prøver at kigge på det. Har dog ikke tid lige nu, men ser på det senere. Tak for hjælpen (indtil videre). Det kan være jeg kontakter dig senere iaften hvis det er ok!?!

Pernille

Helt OK ;-) Jeg kigger på dit andet spm nu.

tjacob>> Har svært ved at overskue din kode. Har lige sendt dig min fil, håber du vil kigge på den!

Pernille>> Den er returneret i rettet tilstand

For alle andre: Her er løsningen:

Sub lin105()
    Dim Dist(2 To 106) As Double, TempMin As Double, Min As Double
    Dim i As Integer, j As Integer, x1 As Integer
    Dim x2 As Integer, y1 As Integer, y2 As Integer
    Dim CalcFrom As Integer, Counted(2 To 106) As Boolean

    Worksheets("lin105").Range("A1").Activate
           
    Cells(1, 7) = "Rækkefølge"
    Cells(2, 7) = Cells(2, 1)
   
    CalcFrom = 2    'start i række 2
    Counted(2) = True  'den første er "talt"
    For j = 3 To 106    'vi skriver i række 3 til 106 -det første er skrevet
        For i = 2 To 106    'tallene står i række 2 til 106
            'Først beregnes alle afstande fra Calcfrom til de andre:
            If i <> CalcFrom And Counted(i) = False Then
                'CalcFrom = det tal vi tjekker fra, Counted(i) = er tjekket hvis True
                x1 = Cells(CalcFrom, 2)
                y1 = Cells(CalcFrom, 3)
                x2 = Cells(i, 2)
                y2 = Cells(i, 3)
                'afstandene skrives i variablen Dist():
                Dist(i) = Sqr((Abs(x1 - x2) ^ 2) + (Abs(y1 - y2) ^ 2))
            End If
        Next i
        'så findes den mindste afstand i Dist():
        TempMin = 9999
        For i = 2 To 106
            If Dist(i) <> 0 And Dist(i) < TempMin Then
                TempMin = Dist(i)
                Min = i
            End If
            Dist(i) = 9999  ' "nulstille" til næste gang
        Next i
        Cells(j, 7) = Min  'tallet skrives i tabellen
        CalcFrom = Min + 1  'Det er fra dette tal der tjekkes i næste løkke
        Counted(Min) = True 'Det er talt nu
    Next j

End Sub

Her er en lidt kortere version:
Sub lin105()
    Dim Dist(2 To 106) As Double, TempMin As Double, Min As Double
    Dim i As Integer, j As Integer, x1 As Integer
    Dim x2 As Integer, y1 As Integer, y2 As Integer
    Dim CalcFrom As Integer, Counted(2 To 106) As Boolean
    Worksheets("lin105").Range("A1").Activate
    Cells(1, 7) = "Rækkefølge"
    Cells(2, 7) = Cells(2, 1)
    CalcFrom = 2
    Counted(2) = True
    For j = 3 To 106
        TempMin = 9999
        For i = 2 To 106
            If i <> CalcFrom And Counted(i) = False Then
                x1 = Cells(CalcFrom, 2)
                y1 = Cells(CalcFrom, 3)
                x2 = Cells(i, 2)
                y2 = Cells(i, 3)
                Dist(i) = Sqr((Abs(x1 - x2) ^ 2) + (Abs(y1 - y2) ^ 2))
            End If
            If Dist(i) <> 0 And Dist(i) < TempMin Then
                TempMin = Dist(i)
                Min = i
            End If
            Dist(i) = 9999
        Next i
        Cells(j, 7) = Min
        CalcFrom = Min + 1
        Counted(Min) = True
    Next j
End Sub

rettelse i fjerdesidste linie:

Cells(j, 7) = Min rettes til Cells(j, 7) = Min -1

/tjacob

Tusind tak for hjælpen...selv om opgaven ikke blev så god! (Men det er ikke din skyld! ;-)  )