Makro ile çekip gruplama

koboy · 28 Kasım 2018

Merhaba 2 sayfam var 1 sayfam GİRİS burada özet sunuyorum.
2 sayfam veri sayfası 2 sayfamdaki verileri GİRİS sayfasına özet tablo olarak değilde grup olarak nasıl getirebilirim.
örnek ekledim

koboy · 28 Kasım 2018

Yardımcı olacak arkadaşlardan rica ediyorum en azından mantık olarak söyleyebilirlerse

YUSUF44 · 29 Kasım 2018

Hazırladığım kodları en azından doğru başlığa göndereyim:

PHP:

Sub kasap()

Set s1 = Sheets("VERİ")
Set s2 = Sheets("GİRİS (2)")
Application.ScreenUpdating = False
son = s1.Cells(Rows.Count, "B").End(3).Row
s2.Range("A5:C" & Rows.Count).Delete
tarih = s2.[B1]
For bölge = 2 To son
    If s1.Cells(bölge, "E") = tarih Then
        If WorksheetFunction.CountIfs(s1.Range("L1:L" & bölge), s1.Cells(bölge, "L"), s1.Range("E1:E" & bölge), tarih) = 1 Then
            yeni = WorksheetFunction.Max(s2.Cells(Rows.Count, "A").End(3).Row + 2, 5)
            bölgeadı = s1.Cells(bölge, "L")
            s2.Cells(yeni, "A") = "BÖLGE"
            s2.Cells(yeni, "B") = bölgeadı
            s2.Cells(yeni + 2, "A") = "MÜŞTERİ"
            s2.Cells(yeni + 2, "B") = "SİPARİŞ MİKTARI"
            s2.Cells(yeni + 2, "C") = "BEKLEYEN MİKTAR"
            With s2.Cells(yeni, "A").Interior
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
                .Color = 7067390
                .TintAndShade = 0
                .PatternTintAndShade = 0
            End With
            With s2.Cells(yeni, "B").Interior
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
                .Color = 10216447
                .TintAndShade = 0
                .PatternTintAndShade = 0
            End With
            With s2.Range("A" & yeni + 2 & ":C" & yeni + 2).Interior
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
                .Color = 7067390
                .TintAndShade = 0
                .PatternTintAndShade = 0
            End With
            s2.Range("A" & yeni + 2 & ":C" & yeni + 2).Font.Bold = True
            With s2.Range("A" & yeni + 2 & ":C" & yeni + 2)
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
                .Orientation = 0
                .AddIndent = False
                .IndentLevel = 0
                .ShrinkToFit = False
                .ReadingOrder = xlContext
                .MergeCells = False
            End With
            
            For müşteri = bölge To son
                If s1.Cells(müşteri, "E") = tarih And s1.Cells(müşteri, "L") = bölgeadı Then
                    If WorksheetFunction.CountIfs(s1.Range("B1:B" & müşteri), s1.Cells(müşteri, "B"), s1.Range("E1:E" & müşteri), tarih) = 1 Then
                        müşteriadı = s1.Cells(müşteri, "B")
                        yeni1 = s2.Cells(Rows.Count, "A").End(3).Row + 1
                        s2.Cells(yeni1, "A") = müşteriadı
                        With s2.Range("A" & yeni1 & ":C" & yeni1).Interior
                            .Pattern = xlSolid
                            .PatternColorIndex = xlAutomatic
                            .Color = 13431295
                            .TintAndShade = 0
                            .PatternTintAndShade = 0
                        End With
                        s2.Range("A" & yeni1 & ":C" & yeni1).Font.Bold = True
                        With s2.Range("A" & yeni1 & ":C" & yeni1)
                            .HorizontalAlignment = xlCenter
                            .VerticalAlignment = xlCenter
                            .WrapText = False
                            .Orientation = 0
                            .AddIndent = False
                            .IndentLevel = 0
                            .ShrinkToFit = False
                            .ReadingOrder = xlContext
                            .MergeCells = False
                        End With
                              
                        For ürün = müşteri To son
                            If s1.Cells(ürün, "B") = müşteriadı And s1.Cells(ürün, "E") = tarih Then
                                If WorksheetFunction.CountIfs(s1.Range("L1:L" & ürün), bölgeadı, s1.Range("B1:B" & ürün), müşteriadı, _
                                    s1.Range("C1:C" & ürün), s1.Cells(ürün, "C"), s1.Range("E1:E" & ürün), tarih) = 1 Then
                                    ürünadı = s1.Cells(ürün, "C")
                                    yeni2 = s2.Cells(Rows.Count, "A").End(3).Row + 1
                                    s2.Cells(yeni2, "A") = ürünadı
                                    s2.Cells(yeni2, "B") = WorksheetFunction.SumIfs(s1.Range("G1:G" & son), _
                                        s1.Range("L1:L" & son), bölgeadı, s1.Range("B1:B" & son), müşteriadı, _
                                        s1.Range("C1:C" & son), ürünadı, s1.Range("E1:E" & son), tarih)
                                    s2.Cells(yeni2, "C") = WorksheetFunction.SumIfs(s1.Range("I1:I" & son), _
                                        s1.Range("L1:L" & son), bölgeadı, s1.Range("B1:B" & son), müşteriadı, _
                                        s1.Range("C1:C" & son), ürünadı, s1.Range("E1:E" & son), tarih)
                                    s1.Range("A" & ürün & ":C" & ürün).Font.Bold = False
                                    s1.Range("A" & ürün & ":C" & ürün).Interior.Color = xlNone
                                End If
                            End If
                        Next
                    End If
                End If
            Next
        End If
    End If
Next
Application.ScreenUpdating = True
End Sub

YUSUF44 · 29 Kasım 2018

Kodun yan yana gruplayan hali:

PHP:

Sub kasap()

Set s1 = Sheets("VERİ")
Set s2 = Sheets("GİRİS (2)")
Application.ScreenUpdating = False
son = s1.Cells(Rows.Count, "B").End(3).Row
s2.Rows("5:" & Rows.Count).Delete
tarih = s2.[B1]
For bölge = 2 To son
    If s1.Cells(bölge, "E") = tarih Then
        If WorksheetFunction.CountIfs(s1.Range("L1:L" & bölge), s1.Cells(bölge, "L"), s1.Range("E1:E" & bölge), tarih) = 1 Then
            If s2.[A5] <> "" Then
                sütun = sütun + 4
            Else
                sütun = 1
            End If
            yeni = WorksheetFunction.Max(s2.Cells(Rows.Count, sütun).End(3).Row + 2, 5)
            bölgeadı = s1.Cells(bölge, "L")
            s2.Cells(yeni, sütun) = "BÖLGE"
            s2.Cells(yeni, sütun + 1) = bölgeadı
            s2.Cells(yeni + 2, sütun) = "MÜŞTERİ"
            s2.Cells(yeni + 2, sütun + 1) = "SİPARİŞ MİKTARI"
            s2.Cells(yeni + 2, sütun + 2) = "BEKLEYEN MİKTAR"
            With s2.Cells(yeni, sütun).Interior
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
                .Color = 7067390
                .TintAndShade = 0
                .PatternTintAndShade = 0
            End With
            With s2.Cells(yeni, sütun + 1).Interior
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
                .Color = 10216447
                .TintAndShade = 0
                .PatternTintAndShade = 0
            End With
            With s2.Range(Cells(yeni + 2, sütun), Cells(yeni + 2, sütun + 2)).Interior
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
                .Color = 7067390
                .TintAndShade = 0
                .PatternTintAndShade = 0
            End With
            s2.Range(Cells(yeni + 2, sütun), Cells(yeni + 2, sütun + 2)).Font.Bold = True
            With s2.Range(Cells(yeni + 2, sütun), Cells(yeni + 2, sütun + 2))
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
                .Orientation = 0
                .AddIndent = False
                .IndentLevel = 0
                .ShrinkToFit = False
                .ReadingOrder = xlContext
                .MergeCells = False
            End With
            
            For müşteri = bölge To son
                If s1.Cells(müşteri, "E") = tarih And s1.Cells(müşteri, "L") = bölgeadı Then
                    If WorksheetFunction.CountIfs(s1.Range("B1:B" & müşteri), s1.Cells(müşteri, "B"), s1.Range("E1:E" & müşteri), tarih) = 1 Then
                        müşteriadı = s1.Cells(müşteri, "B")
                        yeni1 = s2.Cells(Rows.Count, sütun).End(3).Row + 1
                        s2.Cells(yeni1, sütun) = müşteriadı
                        With s2.Range(Cells(yeni1, sütun), Cells(yeni1, sütun + 2)).Interior
                            .Pattern = xlSolid
                            .PatternColorIndex = xlAutomatic
                            .Color = 13431295
                            .TintAndShade = 0
                            .PatternTintAndShade = 0
                        End With
                        s2.Range(Cells(yeni1, sütun), Cells(yeni1, sütun + 2)).Font.Bold = True
                        With s2.Range(Cells(yeni1, sütun), Cells(yeni1, sütun + 2))
                            .HorizontalAlignment = xlCenter
                            .VerticalAlignment = xlCenter
                            .WrapText = False
                            .Orientation = 0
                            .AddIndent = False
                            .IndentLevel = 0
                            .ShrinkToFit = False
                            .ReadingOrder = xlContext
                            .MergeCells = False
                        End With
                              
                        For ürün = müşteri To son
                            If s1.Cells(ürün, "B") = müşteriadı And s1.Cells(ürün, "E") = tarih Then
                                If WorksheetFunction.CountIfs(s1.Range("L1:L" & ürün), bölgeadı, s1.Range("B1:B" & ürün), müşteriadı, _
                                    s1.Range("C1:C" & ürün), s1.Cells(ürün, "C"), s1.Range("E1:E" & ürün), tarih) = 1 Then
                                    ürünadı = s1.Cells(ürün, "C")
                                    yeni2 = s2.Cells(Rows.Count, sütun).End(3).Row + 1
                                    s2.Cells(yeni2, sütun) = ürünadı
                                    s2.Cells(yeni2, sütun + 1) = WorksheetFunction.SumIfs(s1.Range("G1:G" & son), _
                                        s1.Range("L1:L" & son), bölgeadı, s1.Range("B1:B" & son), müşteriadı, _
                                        s1.Range("C1:C" & son), ürünadı, s1.Range("E1:E" & son), tarih)
                                    s2.Cells(yeni2, sütun + 2) = WorksheetFunction.SumIfs(s1.Range("I1:I" & son), _
                                        s1.Range("L1:L" & son), bölgeadı, s1.Range("B1:B" & son), müşteriadı, _
                                        s1.Range("C1:C" & son), ürünadı, s1.Range("E1:E" & son), tarih)
                                    s2.Range(Cells(yeni2, sütun), Cells(yeni2, sütun + 2)).Font.Bold = False
                                    s2.Range(Cells(yeni2, sütun), Cells(yeni2, sütun + 2)).Interior.Color = xlNone
                                End If
                            End If
                        Next
                    End If
                End If
            Next
        End If
    End If
Next
sonsütun = Cells(7, Columns.Count).End(xlToLeft).Column

Application.ScreenUpdating = True
End Sub

YUSUF44 · 30 Kasım 2018

Sayın Ömer BARAN'ın önerisiyle kodda gereksiz kısımları çıkardım ve değişkenlerde kullandığım Türkçe karakterleri değiştirdim. Ayrıca bazı biçim ayarları yaptım. Kodun son hali aşağıdaki gibidir:

PHP:

Sub kasap()

Set s1 = Sheets("VERİ")
Set s2 = Sheets("GİRİS (2)")
Application.ScreenUpdating = False
son = s1.Cells(Rows.Count, "B").End(3).Row
s2.Rows("5:" & Rows.Count).Delete
tarih = s2.[B1]
For bolge = 2 To son
    If s1.Cells(bolge, "E") = tarih Then
        If WorksheetFunction.CountIfs(s1.Range("L1:L" & bolge), s1.Cells(bolge, "L"), s1.Range("E1:E" & bolge), tarih) = 1 Then
            If s2.[A5] <> "" Then
                sutun = sutun + 4
            Else
                sutun = 1
            End If
            If sutun > 1 Then Columns(sutun - 1).ColumnWidth = 4
            yeni = WorksheetFunction.Max(s2.Cells(Rows.Count, sutun).End(3).Row + 2, 5)
            bolgeadi = s1.Cells(bolge, "L")
            s2.Cells(yeni, sutun) = "BÖLGE"
            s2.Cells(yeni, sutun + 1) = bolgeadi
            s2.Cells(yeni + 2, sutun) = "MÜŞTERİ"
            s2.Cells(yeni + 2, sutun + 1) = "SİPARİŞ MİKTARI"
            s2.Cells(yeni + 2, sutun + 2) = "BEKLEYEN MİKTAR"
            s2.Cells(yeni, sutun).Interior.Color = 7067390
            s2.Cells(yeni, sutun + 1).Interior.Color = 10216447
            s2.Range(Cells(yeni + 2, sutun), Cells(yeni + 2, sutun + 2)).Interior.Color = 7067390
            s2.Range(Cells(yeni + 2, sutun), Cells(yeni + 2, sutun + 2)).Font.Bold = True
            With s2.Range(Cells(yeni + 2, sutun), Cells(yeni + 2, sutun + 2))
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
            End With
            Columns(sutun).ColumnWidth = 23
            Columns(sutun + 1).ColumnWidth = 16
            Columns(sutun + 2).ColumnWidth = 17
            For musteri = bolge To son
                If s1.Cells(musteri, "E") = tarih And s1.Cells(musteri, "L") = bolgeadi Then
                    If WorksheetFunction.CountIfs(s1.Range("B1:B" & musteri), s1.Cells(musteri, "B"), s1.Range("E1:E" & musteri), tarih) = 1 Then
                        musteriadi = s1.Cells(musteri, "B")
                        yeni1 = s2.Cells(Rows.Count, sutun).End(3).Row + 1
                        s2.Cells(yeni1, sutun) = musteriadi
                        s2.Range(Cells(yeni1, sutun), Cells(yeni1, sutun + 2)).Interior.Color = 13431295
                        s2.Range(Cells(yeni1, sutun), Cells(yeni1, sutun + 2)).Font.Bold = True
                        With s2.Range(Cells(yeni1, sutun), Cells(yeni1, sutun + 2))
                            .HorizontalAlignment = xlCenter
                            .VerticalAlignment = xlCenter
                        End With
                              
                        For urun = musteri To son
                            If s1.Cells(urun, "B") = musteriadi And s1.Cells(urun, "E") = tarih Then
                                If WorksheetFunction.CountIfs(s1.Range("L1:L" & urun), bolgeadi, s1.Range("B1:B" & urun), musteriadi, _
                                    s1.Range("C1:C" & urun), s1.Cells(urun, "C"), s1.Range("E1:E" & urun), tarih) = 1 Then
                                    urunadi = s1.Cells(urun, "C")
                                    yeni2 = s2.Cells(Rows.Count, sutun).End(3).Row + 1
                                    s2.Cells(yeni2, sutun) = urunadi
                                    s2.Cells(yeni2, sutun + 1) = WorksheetFunction.SumIfs(s1.Range("G1:G" & son), _
                                        s1.Range("L1:L" & son), bolgeadi, s1.Range("B1:B" & son), musteriadi, _
                                        s1.Range("C1:C" & son), urunadi, s1.Range("E1:E" & son), tarih)
                                    s2.Cells(yeni2, sutun + 2) = WorksheetFunction.SumIfs(s1.Range("I1:I" & son), _
                                        s1.Range("L1:L" & son), bolgeadi, s1.Range("B1:B" & son), musteriadi, _
                                        s1.Range("C1:C" & son), urunadi, s1.Range("E1:E" & son), tarih)
                                    s2.Range(Cells(yeni2, sutun), Cells(yeni2, sutun + 2)).Font.Bold = False
                                    s2.Range(Cells(yeni2, sutun), Cells(yeni2, sutun + 2)).Interior.Color = xlNone
                                    s2.Range(Cells(7, sutun + 1), Cells(yeni2, sutun + 2)).NumberFormat = "#,##0.000"
                                End If
                            End If
                        Next
                    End If
                End If
            Next
        End If
    End If
Next
Application.ScreenUpdating = True
MsgBox "İşlem tamamlandı."
End Sub

koboy · 30 Kasım 2018

Çok teşekkür ederim istediğim gibi olmuş elinize sağlık.

bu kodu nasıl ekleyebilirim
veritabanından çektiğim için

Kod:

Sub verigetir()




Dim BitTar As Date    'Declare the BitTar as Date

BitTar = Sheets("GİRİS").Range("B1").Value     'Pass value from cell B4 to BitTar variable

'Pass the Parameters values to the Stored Procedure used in the Data Connection
With ActiveWorkbook.Connections("bekleyen_siparis").ODBCConnection
.CommandText = "select * from dbo.bekleyen_siparis_sevk  ('" & BitTar & "')"
ActiveWorkbook.Connections("bekleyen_siparis").Refresh
    

ActiveWorkbook.RefreshAll

    


End With
End Sub

YUSUF44 · 30 Kasım 2018

Konuyu anlamadım maalesef.

koboy · 30 Kasım 2018

YUSUF44' Alıntı:
Konuyu anlamadım maalesef.

Sizin yaptığınız kodun içine bu kodu nasıl entegre edebilirim makro ile veritabanından sorgu alıyorum veri sayfasını çekiyorum
Sonra giriş sayfasına listeliyorum sizin yaptınız makro ile

YUSUF44 · 30 Kasım 2018

Eğer her şey doğru yapılmışsa sanıyorum benim kodlarda ikinci satır olarak (sub ve set satırları arasına)
call verigetir
eklediğinizde önce verigetir makrosu çalışır. Ancak doğru çalışır mı bilemem.

koboy · 30 Kasım 2018

Yusuf bey merhaba
Set s1 = Sheets("VERİ")
Set s2 = Sheets("GİRİS (2)")
sayfa ismi değisebiliyor bunu yerine vba gözüken Örn: Sayfa3 nasıl aldırabilirim

YUSUF44 · 30 Kasım 2018

Set s2 = ActiveSheet

Yaparsanız makroyu çalıştırdığınız sayfada raporlama yapar.

koboy · 30 Kasım 2018

teşekkür ederim

koboy · 4 Aralık 2018

Yusuf abi merhaba kodun çalışıyor çok güzel olmuş eline sağlık söyle bir sorunum Doğuş ismi doğru tek gelecek
ançak ürün kodu birleştirme yapmacak bunu nasıl çözebilirim

Kod:

Sub kasap()


Set s1 = Sheets("VERİ")
Set s2 = Sheets("GİRİS")
Application.ScreenUpdating = False
son = s1.Cells(Rows.Count, "B").End(3).Row
s2.Rows("5:" & Rows.Count).Delete
tarih = s2.[B1]
For bolge = 2 To son
    If s1.Cells(bolge, "E") = tarih Then
        If WorksheetFunction.CountIfs(s1.Range("L1:L" & bolge), s1.Cells(bolge, "L"), s1.Range("E1:E" & bolge), tarih) = 1 Then
            If s2.[A5] <> "" Then
                sutun = sutun + 4
            Else
                sutun = 1
            End If
            If sutun > 1 Then Columns(sutun - 1).ColumnWidth = 4
            yeni = WorksheetFunction.Max(s2.Cells(Rows.Count, sutun).End(3).Row + 2, 5)
            bolgeadi = s1.Cells(bolge, "L")
            s2.Cells(yeni, sutun) = "BÖLGE"
            s2.Cells(yeni, sutun + 1) = bolgeadi
            s2.Cells(yeni + 2, sutun) = "MÜŞTERİ"
            s2.Cells(yeni + 2, sutun + 1) = "SİPARİŞ MİKTARI"
            s2.Cells(yeni + 2, sutun + 2) = "FATURA EDİLEN MİKTAR"
            s2.Cells(yeni, sutun).Interior.Color = RGB(200, 159, 93)
           s2.Cells(yeni, sutun).Font.Color = RGB(255, 255, 255)
            s2.Cells(yeni, sutun + 1).Interior.Color = RGB(221, 198, 157)
            s2.Range(Cells(yeni, sutun), Cells(yeni + 2, sutun + 2)).Font.Bold = True
        
      
            s2.Range(Cells(yeni + 2, sutun), Cells(yeni + 2, sutun + 2)).Interior.Color = RGB(200, 159, 93)
            s2.Range(Cells(yeni + 2, sutun), Cells(yeni + 2, sutun + 2)).Font.Bold = True
            s2.Range(Cells(yeni + 2, sutun), Cells(yeni + 2, sutun + 2)).Font.Color = RGB(255, 255, 255)
            With s2.Range(Cells(yeni, sutun), Cells(yeni + 2, sutun + 2))
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
            End With
             Columns(sutun).ColumnWidth = 32
            Columns(sutun).ColumnWidth = 32
            Columns(sutun + 1).ColumnWidth = 14
            Columns(sutun + 2).ColumnWidth = 14
            Range("A5" & i).EntireRow.RowHeight = 23
            For musteri = bolge To son
                If s1.Cells(musteri, "E") = tarih And s1.Cells(musteri, "L") = bolgeadi Then
                    If WorksheetFunction.CountIfs(s1.Range("B1:B" & musteri), s1.Cells(musteri, "B"), s1.Range("E1:E" & musteri), tarih) = 1 Then
                        musteriadi = s1.Cells(musteri, "B")
                        yeni1 = s2.Cells(Rows.Count, sutun).End(3).Row + 1
                        s2.Cells(yeni1, sutun) = musteriadi
                        s2.Range(Cells(yeni1, sutun), Cells(yeni1, sutun + 2)).Interior.Color = RGB(243, 236, 222)
                        s2.Range(Cells(yeni1, sutun), Cells(yeni1, sutun + 2)).Font.Bold = True
                        With s2.Range(Cells(yeni1, sutun), Cells(yeni1, sutun + 2))
                            .HorizontalAlignment = xlCenter
                            .VerticalAlignment = xlCenter
                        End With
                              
                        For urun = musteri To son
                            If s1.Cells(urun, "B") = musteriadi And s1.Cells(urun, "E") = tarih Then
                                If WorksheetFunction.CountIfs(s1.Range("L1:L" & urun), bolgeadi, s1.Range("B1:B" & urun), musteriadi, _
                                    s1.Range("C1:C" & urun), s1.Cells(urun, "C"), s1.Range("E1:E" & urun), tarih) = 1 Then
                                    urunadi = s1.Cells(urun, "C")
                                    yeni2 = s2.Cells(Rows.Count, sutun).End(3).Row + 1
                                    s2.Cells(yeni2, sutun) = urunadi
                                    s2.Cells(yeni2, sutun + 1) = WorksheetFunction.SumIfs(s1.Range("G1:G" & son), _
                                        s1.Range("L1:L" & son), bolgeadi, s1.Range("B1:B" & son), musteriadi, _
                                        s1.Range("C1:C" & son), urunadi, s1.Range("E1:E" & son), tarih)
                                    s2.Cells(yeni2, sutun + 2) = WorksheetFunction.SumIfs(s1.Range("H1:H" & son), _
                                        s1.Range("L1:L" & son), bolgeadi, s1.Range("B1:B" & son), musteriadi, _
                                        s1.Range("C1:C" & son), urunadi, s1.Range("E1:E" & son), tarih)
                                    s2.Range(Cells(yeni2, sutun), Cells(yeni2, sutun + 2)).Font.Bold = False
                                    s2.Range(Cells(yeni2, sutun), Cells(yeni2, sutun + 2)).Interior.Color = xlNone
                                    s2.Range(Cells(7, sutun + 1), Cells(yeni2, sutun + 2)).NumberFormat = "#,##0.000"
                                End If
                            End If
                        Next
                    End If
                End If
                
                
    
                
            Next
        End If
    End If
Next

Application.ScreenUpdating = True
MsgBox "İŞLEM TAMAMLANDI"
End Sub

YUSUF44 · 4 Aralık 2018

Anlamadım maalesef.

koboy · 4 Aralık 2018

miktar kısmını sum yapıyor ya abi dana kıyma 3 tane var mesala
3 nü topluyo tek gruplayım dana kıyma yazıyor

koboy · 4 Aralık 2018

resim gönderdim 3 tane kıyma var ama veri getirirken topluyor tek getiriyor

YUSUF44 · 4 Aralık 2018

Aşağıdaki gibi deneyin. Bir de bundan sonraki sorularınızda lütfen soruyu sonradan değiştirmeyin, tüm alternatifleri önceden sorun:

PHP:

Sub kasap()


Set s1 = Sheets("VERİ")
Set s2 = ActiveSheet
Application.ScreenUpdating = False
son = s1.Cells(Rows.Count, "B").End(3).Row
s2.Rows("5:" & Rows.Count).Delete
tarih = s2.[B1]
For bolge = 2 To son
    If s1.Cells(bolge, "E") = tarih Then
        If WorksheetFunction.CountIfs(s1.Range("L1:L" & bolge), s1.Cells(bolge, "L"), s1.Range("E1:E" & bolge), tarih) = 1 Then
            If s2.[A5] <> "" Then
                sutun = sutun + 4
            Else
                sutun = 1
            End If
            If sutun > 1 Then Columns(sutun - 1).ColumnWidth = 4
            yeni = WorksheetFunction.Max(s2.Cells(Rows.Count, sutun).End(3).Row + 2, 5)
            bolgeadi = s1.Cells(bolge, "L")
            s2.Cells(yeni, sutun) = "BÖLGE"
            s2.Cells(yeni, sutun + 1) = bolgeadi
            s2.Cells(yeni + 2, sutun) = "MÜŞTERİ"
            s2.Cells(yeni + 2, sutun + 1) = "SİPARİŞ MİKTARI"
            s2.Cells(yeni + 2, sutun + 2) = "FATURA EDİLEN MİKTAR"
            s2.Cells(yeni, sutun).Interior.Color = RGB(200, 159, 93)
           s2.Cells(yeni, sutun).Font.Color = RGB(255, 255, 255)
            s2.Cells(yeni, sutun + 1).Interior.Color = RGB(221, 198, 157)
            s2.Range(Cells(yeni, sutun), Cells(yeni + 2, sutun + 2)).Font.Bold = True
        
      
            s2.Range(Cells(yeni + 2, sutun), Cells(yeni + 2, sutun + 2)).Interior.Color = RGB(200, 159, 93)
            s2.Range(Cells(yeni + 2, sutun), Cells(yeni + 2, sutun + 2)).Font.Bold = True
            s2.Range(Cells(yeni + 2, sutun), Cells(yeni + 2, sutun + 2)).Font.Color = RGB(255, 255, 255)
            With s2.Range(Cells(yeni, sutun), Cells(yeni + 2, sutun + 2))
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
            End With
             Columns(sutun).ColumnWidth = 32
            Columns(sutun).ColumnWidth = 32
            Columns(sutun + 1).ColumnWidth = 14
            Columns(sutun + 2).ColumnWidth = 14
            Range("A5" & i).EntireRow.RowHeight = 23
            For musteri = bolge To son
                If s1.Cells(musteri, "E") = tarih And s1.Cells(musteri, "L") = bolgeadi Then
                    If WorksheetFunction.CountIfs(s1.Range("B1:B" & musteri), s1.Cells(musteri, "B"), s1.Range("E1:E" & musteri), tarih) = 1 Then
                        musteriadi = s1.Cells(musteri, "B")
                        yeni1 = s2.Cells(Rows.Count, sutun).End(3).Row + 1
                        s2.Cells(yeni1, sutun) = musteriadi
                        s2.Range(Cells(yeni1, sutun), Cells(yeni1, sutun + 2)).Interior.Color = RGB(243, 236, 222)
                        s2.Range(Cells(yeni1, sutun), Cells(yeni1, sutun + 2)).Font.Bold = True
                        With s2.Range(Cells(yeni1, sutun), Cells(yeni1, sutun + 2))
                            .HorizontalAlignment = xlCenter
                            .VerticalAlignment = xlCenter
                        End With
                              
                        For urun = musteri To son
                            If s1.Cells(urun, "B") = musteriadi And s1.Cells(urun, "E") = tarih Then
                                    urunadi = s1.Cells(urun, "C")
                                    yeni2 = s2.Cells(Rows.Count, sutun).End(3).Row + 1
                                    s2.Cells(yeni2, sutun) = urunadi
                                    s2.Cells(yeni2, sutun + 1) = WorksheetFunction.SumIfs(s1.Range("G1:G" & son), _
                                        s1.Range("L1:L" & son), bolgeadi, s1.Range("B1:B" & son), musteriadi, _
                                        s1.Range("C1:C" & son), urunadi, s1.Range("E1:E" & son), tarih)
                                    s2.Cells(yeni2, sutun + 2) = WorksheetFunction.SumIfs(s1.Range("H1:H" & son), _
                                        s1.Range("L1:L" & son), bolgeadi, s1.Range("B1:B" & son), musteriadi, _
                                        s1.Range("C1:C" & son), urunadi, s1.Range("E1:E" & son), tarih)
                                    s2.Range(Cells(yeni2, sutun), Cells(yeni2, sutun + 2)).Font.Bold = False
                                    s2.Range(Cells(yeni2, sutun), Cells(yeni2, sutun + 2)).Interior.Color = xlNone
                                    s2.Range(Cells(7, sutun + 1), Cells(yeni2, sutun + 2)).NumberFormat = "#,##0.000"
                            End If
                        Next
                    End If
                End If
                
                
    
                
            Next
        End If
    End If
Next

Application.ScreenUpdating = True
MsgBox "İŞLEM TAMAMLANDI"
End Sub

koboy · 4 Aralık 2018

tek tek geldi abi ama miktarları hatalı geldi
dosya ekledim

koboy · 4 Aralık 2018

Abi sum yapıyor toplamı alt alta 3 kez yazdı

YUSUF44 · 4 Aralık 2018

Aşağıdaki gibi deneyin. Bir de bundan sonraki sorularınızda lütfen soruyu sonradan değiştirmeyin, tüm alternatifleri önceden sorun:

PHP:

Sub kasap()


Set s1 = Sheets("VERİ")
Set s2 = ActiveSheet
Application.ScreenUpdating = False
son = s1.Cells(Rows.Count, "B").End(3).Row
s2.Rows("5:" & Rows.Count).Delete
tarih = s2.[B1]
For bolge = 2 To son
    If s1.Cells(bolge, "E") = tarih Then
        If WorksheetFunction.CountIfs(s1.Range("L1:L" & bolge), s1.Cells(bolge, "L"), s1.Range("E1:E" & bolge), tarih) = 1 Then
            If s2.[A5] <> "" Then
                sutun = sutun + 4
            Else
                sutun = 1
            End If
            If sutun > 1 Then Columns(sutun - 1).ColumnWidth = 4
            yeni = WorksheetFunction.Max(s2.Cells(Rows.Count, sutun).End(3).Row + 2, 5)
            bolgeadi = s1.Cells(bolge, "L")
            s2.Cells(yeni, sutun) = "BÖLGE"
            s2.Cells(yeni, sutun + 1) = bolgeadi
            s2.Cells(yeni + 2, sutun) = "MÜŞTERİ"
            s2.Cells(yeni + 2, sutun + 1) = "SİPARİŞ MİKTARI"
            s2.Cells(yeni + 2, sutun + 2) = "FATURA EDİLEN MİKTAR"
            s2.Cells(yeni, sutun).Interior.Color = RGB(200, 159, 93)
           s2.Cells(yeni, sutun).Font.Color = RGB(255, 255, 255)
            s2.Cells(yeni, sutun + 1).Interior.Color = RGB(221, 198, 157)
            s2.Range(Cells(yeni, sutun), Cells(yeni + 2, sutun + 2)).Font.Bold = True
       
     
            s2.Range(Cells(yeni + 2, sutun), Cells(yeni + 2, sutun + 2)).Interior.Color = RGB(200, 159, 93)
            s2.Range(Cells(yeni + 2, sutun), Cells(yeni + 2, sutun + 2)).Font.Bold = True
            s2.Range(Cells(yeni + 2, sutun), Cells(yeni + 2, sutun + 2)).Font.Color = RGB(255, 255, 255)
            With s2.Range(Cells(yeni, sutun), Cells(yeni + 2, sutun + 2))
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
            End With
             Columns(sutun).ColumnWidth = 32
            Columns(sutun).ColumnWidth = 32
            Columns(sutun + 1).ColumnWidth = 14
            Columns(sutun + 2).ColumnWidth = 14
            Range("A5" & i).EntireRow.RowHeight = 23
            For musteri = bolge To son
                If s1.Cells(musteri, "E") = tarih And s1.Cells(musteri, "L") = bolgeadi Then
                    If WorksheetFunction.CountIfs(s1.Range("B1:B" & musteri), s1.Cells(musteri, "B"), s1.Range("E1:E" & musteri), tarih) = 1 Then
                        musteriadi = s1.Cells(musteri, "B")
                        yeni1 = s2.Cells(Rows.Count, sutun).End(3).Row + 1
                        s2.Cells(yeni1, sutun) = musteriadi
                        s2.Range(Cells(yeni1, sutun), Cells(yeni1, sutun + 2)).Interior.Color = RGB(243, 236, 222)
                        s2.Range(Cells(yeni1, sutun), Cells(yeni1, sutun + 2)).Font.Bold = True
                        With s2.Range(Cells(yeni1, sutun), Cells(yeni1, sutun + 2))
                            .HorizontalAlignment = xlCenter
                            .VerticalAlignment = xlCenter
                        End With
                             
                        For urun = musteri To son
                            If s1.Cells(urun, "B") = musteriadi And s1.Cells(urun, "E") = tarih Then
                                    urunadi = s1.Cells(urun, "C")
                                    yeni2 = s2.Cells(Rows.Count, sutun).End(3).Row + 1
                                    s2.Cells(yeni2, sutun) = urunadi
                                    s2.Cells(yeni2, sutun + 1) = WorksheetFunction.SumIfs(s1.Range("G1:G" & son), _
                                        s1.Range("L1:L" & son), bolgeadi, s1.Range("B1:B" & son), musteriadi, _
                                        s1.Range("C1:C" & son), urunadi, s1.Range("E1:E" & son), tarih)
                                    s2.Cells(yeni2, sutun + 2) = WorksheetFunction.SumIfs(s1.Range("H1:H" & son), _
                                        s1.Range("L1:L" & son), bolgeadi, s1.Range("B1:B" & son), musteriadi, _
                                        s1.Range("C1:C" & son), urunadi, s1.Range("E1:E" & son), tarih)
                                    s2.Range(Cells(yeni2, sutun), Cells(yeni2, sutun + 2)).Font.Bold = False
                                    s2.Range(Cells(yeni2, sutun), Cells(yeni2, sutun + 2)).Interior.Color = xlNone
                                    s2.Range(Cells(7, sutun + 1), Cells(yeni2, sutun + 2)).NumberFormat = "#,##0.000"
                            End If
                        Next
                    End If
                End If
               
               
   
               
            Next
        End If
    End If
Next

Application.ScreenUpdating = True
MsgBox "İŞLEM TAMAMLANDI"
End Sub

Makro ile çekip gruplama

koboy

Ekli dosyalar

koboy

YUSUF44

Destek Ekibi

YUSUF44

Destek Ekibi

YUSUF44

Destek Ekibi

koboy

YUSUF44

Destek Ekibi

koboy

YUSUF44

Destek Ekibi

koboy

YUSUF44

Destek Ekibi

koboy

koboy

Ekli dosyalar

YUSUF44

Destek Ekibi

koboy

koboy

YUSUF44

Destek Ekibi

koboy

Ekli dosyalar

koboy

YUSUF44

Destek Ekibi