• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Macro Matrix & Yakın Komşu Sezgiseli

  • Konbuyu başlatan Konbuyu başlatan ergn7
  • Başlangıç tarihi Başlangıç tarihi
Katılım
1 Haziran 2011
Mesajlar
5
Excel Vers. ve Dili
2010 visual
Merhaba;

Macro'da matrix olusturma konusunda sorun yasiyorum. Internette cok inceledim. Parca parca seyler buldum. Birlestirdim ama isin icinden cikamadim. Ekteki dosyada, yapmaya cabaladigim isi acikladim.

Yardimci olabilirseniz cok memnun olacagim.
 

Ekli dosyalar

Merhaba;

Macro'da matrix olusturma konusunda sorun yasiyorum. Internette cok inceledim. Parca parca seyler buldum. Birlestirdim ama isin icinden cikamadim. Ekteki dosyada, yapmaya cabaladigim isi acikladim.

Yardimci olabilirseniz cok memnun olacagim.
Merhaba.
Kod:
Sub Düğme4_Tıklat()
Set s1 = Sheets("UzaklıkMatrisi")
For x = 1 To 2
For a = 3 To 31
If x = 2 Then c = 1
s1.Cells(x, a) = Cells(a, x)
s1.Cells(a, x) = Cells(a, x + c)
Next: Next
For x = 3 To 31
For a = 3 To 31
s1.Cells(x, a) = s1.Cells(x, 2) - s1.Cells(2, a)
Next: Next
End Sub
 
Son düzenleme:
Merhaba.
Başlangıç noktası "1150" mi?

hocanın verdiği soru bu maalesef. ama 1150 1.şehrin x koordinatı anladığım kadarıyla. ve yarın öğlen son teslim.


Sub Düğme1_Tıklat()

Dim i As Long
Dim j As Integer, Sutun As Double
Dim arasonucx1, arasonucy1, arasonucx2, arasonucy2 As Double
Dim x, y, sonuc, sonuc1 As Double


Dim s1 As Worksheet, s2 As Worksheet
Dim DonguDeger As String
Set s1 = Sheets("Koordinat")
Set s2 = Sheets("UzaklıkMatrisi")

s2.Select
For i = 2 To s1.[A65536].End(3).Row
If s1.Cells(i, "A") <> DonguDeger Then
DonguDeger = s1.Cells(i, "A")
j = j + 1
Sutun = 1
Cells(j + 1, Sutun) = s1.Cells(i, "A")
End If
Next

For i = 3 To s1.[A65536].End(3).Row
If s1.Cells(i, "A") <> DonguDeger Then
DonguDeger = s1.Cells(i, "A")
j = j + 1
Sutun = Sutun + 1
Cells(2, Sutun) = s1.Cells(i, "A")
End If
Next

For i = 3 To 31
If i = 3 Then
Cells(3, 2) = "X"
Else
Cells(i, i - 1) = "X"
End If
Next

For i = 3 To 31
For j = 3 To 31
arasonucx1 = s1.Cells(i, "B")
arasonucx2 = s1.Cells(i + 1, "B")
arasonucy1 = s1.Cells(i, "C")
arasonucy2 = s1.Cells(i + 1, "C")
x = arasonucx1 ^ 2
y = arasonucx2 ^ 2
sonuc = Math.Sqr(x - arasonucx2)
If i = j Then GoTo x
Cells(j, i - 1) = sonuc
x:
Next


Next
End Sub

çözümüm bu ilk soru için fakat doğrumu anlayamadım
 
yardımcı olabilirseniz çok sevinirim
 
Geri
Üst