Soru 9

312 defa okundu

9. sorumuzla devam edelim.

Aşağıdaki gibi bir tablomuz var. Bu tabloda bazı illerin, arasındaki mesafeler yer alıyor.

Sol tarafta yer alan tabloyu, sağ taraftaki formata getirmek istiyorum. Sarı renkli hücreleri, özellikle makro ile döngü oluşturarak yapmak istiyorum.

Dosyayı buradan indirebilir, cevaplarınızı yorum olarak yazabilirsiniz.


CEVAP

Bunlar da ilginizi çekebilir

  1. kadir dedi ki:

    Merhaba hocam , mesafeleri dizi elemanlarına atayıp sonra da her dizi elemanını örneğin cells(i,7)=dizi[0]
    gibi atamayla döngü içerisinde hücrelere yazdırıcaz.

    Benim için demesi çok kolay yapması biraz zor :)))

  2. Abdullah Özdem dedi ki:

    Hocam Merhabalar,

    Sub Düğme1_Tıkla()

    Z = 2

    For i = 3 To 18

    For q = 7 To 10

    Cells(Z, q) = Cells(i, 3)

    i = i + 1

    Next q

    i = i – 1

    Z = Z + 1

    Next i

    End Sub

  3. Seyhun dedi ki:

    Pivot ile yaptım. Güvenlik sebebiyle Makro çalışmıyor.

    • MEHMET BÜLBÜL dedi ki:

      Merhaba;
      Pivot ile nasıl çözdünüz acaba? Çözümü paylaşabilir misiniz?

  4. Murat Özlü dedi ki:

    Sub odev9()

    For i = 3 To 18

    If Cells(i, 1) = Cells(2, 6) And Cells(i, 2) = Cells(1, 7) Then
    Cells(2, 7) = Cells(i, 3)
    ElseIf Cells(i, 1) = Cells(3, 6) And Cells(i, 2) = Cells(1, 7) Then
    Cells(3, 7) = Cells(i, 3)
    ElseIf Cells(i, 1) = Cells(4, 6) And Cells(i, 2) = Cells(1, 7) Then
    Cells(4, 7) = Cells(i, 3)
    ElseIf Cells(i, 1) = Cells(5, 6) And Cells(i, 2) = Cells(1, 7) Then
    Cells(5, 7) = Cells(i, 3)

    ElseIf Cells(i, 1) = Cells(2, 6) And Cells(i, 2) = Cells(1, 8) Then
    Cells(2, 8) = Cells(i, 3)
    ElseIf Cells(i, 1) = Cells(3, 6) And Cells(i, 2) = Cells(1, 8) Then
    Cells(3, 8) = Cells(i, 3)
    ElseIf Cells(i, 1) = Cells(4, 6) And Cells(i, 2) = Cells(1, 8) Then
    Cells(4, 8) = Cells(i, 3)
    ElseIf Cells(i, 1) = Cells(5, 6) And Cells(i, 2) = Cells(1, 8) Then
    Cells(5, 8) = Cells(i, 3)

    ElseIf Cells(i, 1) = Cells(2, 6) And Cells(i, 2) = Cells(1, 9) Then
    Cells(2, 9) = Cells(i, 3)
    ElseIf Cells(i, 1) = Cells(3, 6) And Cells(i, 2) = Cells(1, 9) Then
    Cells(3, 9) = Cells(i, 3)
    ElseIf Cells(i, 1) = Cells(4, 6) And Cells(i, 2) = Cells(1, 9) Then
    Cells(4, 9) = Cells(i, 3)
    ElseIf Cells(i, 1) = Cells(5, 6) And Cells(i, 2) = Cells(1, 9) Then
    Cells(5, 9) = Cells(i, 3)

    ElseIf Cells(i, 1) = Cells(2, 6) And Cells(i, 2) = Cells(1, 10) Then
    Cells(2, 10) = Cells(i, 3)
    ElseIf Cells(i, 1) = Cells(3, 6) And Cells(i, 2) = Cells(1, 10) Then
    Cells(3, 10) = Cells(i, 3)
    ElseIf Cells(i, 1) = Cells(4, 6) And Cells(i, 2) = Cells(1, 10) Then
    Cells(4, 10) = Cells(i, 3)
    ElseIf Cells(i, 1) = Cells(5, 6) And Cells(i, 2) = Cells(1, 10) Then
    Cells(5, 10) = Cells(i, 3)

    End If

    Next i

    End Sub

  5. Mustafa dedi ki:

    Merhabalar;
    Tüm tabloyu oluşturmak için kullanılabilecek kod;

    Option Explicit
    Sub Tablo_Olustur()
    Dim sonSutun&, sonF&, sonA&, t&, x&, y&, z&
    Application.ScreenUpdating = False
    ‘————————————————
    ‘F1 den itibaren dolu olan hücrelerin içeriğini temizleme işlemi
    sonSutun = Cells(1, Columns.Count).End(xlToLeft).Column
    sonF = Cells(Rows.Count, “F”).End(xlUp).Row
    sonA = Cells(Rows.Count, “A”).End(xlUp).Row
    Range(Cells(1, “F”), Cells(sonF, sonSutun)).Clear
    ‘————————————————
    ‘Şehir İsimlerini Sıralama İşlemi
    Range(“F1”) = “İL ADI”
    For x = 3 To sonA
    sonF = Cells(Rows.Count, “F”).End(xlUp).Row + 1
    sonSutun = Cells(1, Columns.Count).End(xlToLeft).Column + 1
    If Cells(x, “A”) Cells(x – 1, “A”) Then
    Cells(sonF, “F”) = Cells(x, “A”)
    End If

    If WorksheetFunction.CountIf(Range(Cells(3, 2), Cells(x, “B”)), Cells(x, “B”)) = 1 Then
    Cells(1, sonSutun) = Cells(x, “B”)
    Cells(1, sonSutun).Orientation = 90
    End If
    Next x
    ‘————————————————
    ‘Tabloyu Doldurma İşlemi
    For y = 3 To sonA
    For t = 2 To sonF
    For z = 7 To sonSutun
    If Cells(t, “F”) = Cells(y, “A”) And Cells(1, z) = Cells(y, “B”) Then
    Cells(t, z) = Cells(y, “C”)
    With Cells(t, z)
    .NumberFormat = “#,##0”
    .Borders(xlEdgeLeft).LineStyle = xlContinuous
    .Borders(xlEdgeTop).LineStyle = xlContinuous
    .Borders(xlEdgeBottom).LineStyle = xlContinuous
    .Borders(xlEdgeRight).LineStyle = xlContinuous
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlCenter
    .Interior.ColorIndex = 6
    End With
    If Cells(t, z) = 0 Or Cells(t, z) = Empty Then Cells(t, z) = “-”
    End If
    Next z
    Next t
    Next y
    Range(“F:F”).EntireColumn.AutoFit
    Rows(“1:1”).EntireRow.AutoFit
    sonSutun = Empty: sonA = Empty: sonF = Empty
    t = Empty: x = Empty: y = Empty: z = Empty
    Application.ScreenUpdating = True
    End Sub

  6. Osman dedi ki:

    Sub kilometre()

    sonsatir = Cells(Rows.Count, “a”).End(xlUp).Row
    Range(“f1”) = “IL ADI”

    For i = 3 To sonsatir
    Cells(i – 1, 6) = Cells(i, 1)
    Next i

    Range(“f2”, “f” & sonsatir).RemoveDuplicates (1)
    sonsatir2 = Cells(Rows.Count, “f”).End(xlUp).Row

    For y = 2 To sonsatir2
    Cells(1, 6 + y – 1) = Cells(y, 6)
    Next y

    For Z = 2 To sonsatir2
    For t = sonsatir2 + 2 To sonsatir2 * 2
    Cells(Z, t) = Application.WorksheetFunction.SumIfs(Range(“c2”, “c” & sonsatir), Range(“a2”, “a” & sonsatir), _
    Cells(Z, 6), Range(“b2”, “b” & sonsatir), Cells(1, t))
    Next t
    Next Z

    End Sub

  7. Alper Düryaz dedi ki:

    Sub alper()
    Dim satir As Long
    Dim sutun As Long
    Dim x As Long
    Dim r As Long
    Dim c As Long
    Dim dizim(18, 2) As String

    satir = 2
    sutun = 7

    Range(“F:K”).ClearContents
    Cells(1, “F”) = “İL ADI”

    For r = 3 To 18
    dizim(r – 3, 1) = Cells(r, 1) & Cells(r, 2)
    If Cells(r, 3) = “” Then
    dizim(r – 3, 2) = 0
    Else
    dizim(r – 3, 2) = Cells(r, 3)
    End If

    If Cells(satir – 1, “F”) Cells(r, 1) Then
    Cells(satir, “F”) = Cells(r, 1)
    Cells(1, sutun) = Cells(r, 1)

    satir = satir + 1
    sutun = sutun + 1
    End If
    Next r

    For r = 2 To 5
    For c = 7 To 10
    For x = LBound(dizim) To UBound(dizim)
    If dizim(x, 1) = Cells(r, 6) & Cells(1, c) Then
    Cells(r, c) = dizim(x, 2)
    End If
    Next x
    Next c
    Next r
    End Sub

Bir cevap yazın

E-posta hesabınız yayımlanmayacak. Gerekli alanlar * ile işaretlenmişlerdir

This site uses Akismet to reduce spam. Learn how your comment data is processed.