LİSTE DETAYI

[sonererim]

Müşterimin liste detayını yapamadım. İlgili açıklamayı dosyanın içinde sayfa1 de yaptım. İlgilenen arkadaşlara şimdiden teşekkürler

 

[Muzaffer Ali]

Merhaba.

İnternet yazışmalarında büyük harf kullanmanın ne anlama geldiğini buraya tıklayarak öğrenebilirsiniz.

 

[sonererim]

Özür dilerim. Ama aklımın ucundan kötü niyet ve kızgınlık geçmedi. Tekrar özür dilerim.

 

[Ömer]

Merhaba,

Veriler ÖZET sayfasına listelenir.

Sub Duzenle()

    Dim d As Object, i As Long, s, deg, a1, a2, j As Byte, a As Long, k As Object, deg1
    Dim S1 As Worksheet, S2 As Worksheet, adr1 As String, adr2 As String, son As Long
    
    Set d = CreateObject("Scripting.Dictionary")
    Set k = CreateObject("Scripting.Dictionary")
    Set S1 = Sheets("LİSTE") 'verilerin alındığı sayfa
    Set S2 = Sheets("ÖZET") 'özetin yazıldığı sayfa
    
    Application.ScreenUpdating = False
    S1.Select: S2.Cells.Clear
    
    a = 4: son = Cells(Rows.Count, "B").End(xlUp).Row
    
    For i = 6 To son
        deg = Cells(i, "B")
        If Not d.exists(deg) Then
            s = Array(Cells(i, "F"), Cells(i, "W"))
            d.Add deg, s
        Else
            s = d.Item(deg)
            s(0) = s(0) + Cells(i, "F")
            s(1) = s(1) + Cells(i, "W")
            d.Item(deg) = s
        End If
        
        For j = 7 To 22
            If Cells(i, j) <> "" Then
                deg1 = Cells(i, j)
                If Not k.exists(deg1) Then
                    S2.Cells(2, a) = Cells(i, j)
                    k.Add deg1, Nothing
                    a = a + 1
                End If
            End If
        Next j
    Next i

    adr1 = S1.Range("B6:B" & son).Address(external:=True)
    adr2 = S1.Range("G6:V" & son).Address(external:=True)
    
    S2.Select
    Range("A2").Resize(1, 3) = [{"DESEN NO","TOP ADEDİ","METRE"}]
    Rows("2").Font.Bold = True
    
    a1 = d.keys: a2 = d.items
    
    For i = 0 To d.Count - 1
        s = a2(i)
        Cells(i + 3, "A") = a1(i)
        Cells(i + 3, "B") = s(0)
        Cells(i + 3, "C") = s(1)
        For j = 4 To Cells(2, Columns.Count).End(xlToLeft).Column
            Cells(i + 3, j) = Evaluate("=SumProduct((" _
                & adr1 & "=" & Cells(i + 3, "A").Address & ")*(" & adr2 & "=" & Cells(2, j).Address & "))")
        Next j
    Next i

    With S2.Sort
        .SortFields.Clear
        .SortFields.Add Key:=Range(Cells(2, 4), Cells(2, j - 1)), SortOn:=xlSortOnValues, _
            Order:=xlDescending, DataOption:=xlSortNormal
        .SetRange Range(Cells(2, 4), Cells(i + 2, j - 1))
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlLeftToRight
        .SortMethod = xlPinYin
        .Apply
        .SortFields.Clear
    End With
    Range(Cells(3, 1), Cells(i + 2, j - 1)).Sort Key1:=Range("A2"), Order1:=xlAscending
    
    Cells(i + 3, "A") = "Genel Toplam"
    Cells(i + 3, "B") = "=Sum(B3:B" & i + 2 & ")"
    Cells(i + 3, "C") = "=Sum(C3:C" & i + 2 & ")"
    
    For j = 4 To Cells(2, Columns.Count).End(xlToLeft).Column
        Cells(i + 3, j) = "=" & Cells(2, j).Address & "* Sum(" & Range(Cells(3, j), Cells(i + 2, j)).Address & " )"
    Next j
    
    Cells.EntireColumn.AutoFit
    Cells.EntireRow.AutoFit
    Cells.HorizontalAlignment = xlCenter
    
    Application.ScreenUpdating = True

End Sub

 

[Muzaffer Ali]

Özür dilerim. Ama aklımın ucundan kötü niyet ve kızgınlık geçmedi. Tekrar özür dilerim.

Ben de sadece bilgi amaçlı paylaşmıştım.
Selametle