Soru 9

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

Sub Soru9()

For i = 2 To 5
    For y = 7 To 10
    Cells(i, y) = WorksheetFunction.SumIfs(Range("C:C"), _
    Range("A:A"), Cells(i, 6), Range("B:B"), Cells(1, y))
    Next y
Next i

End Sub

Similar Posts

8 Comments

  1. 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. 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

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

  3. 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

  4. 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

  5. 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

  6. 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

Mustafa için bir yanıt yazın Yanıtı iptal et

E-posta adresiniz yayınlanmayacak. Gerekli alanlar * ile işaretlenmişlerdir

Bu site, istenmeyenleri azaltmak için Akismet kullanıyor. Yorum verilerinizin nasıl işlendiği hakkında daha fazla bilgi edinin.