1 satır boşluk bırakıp müşteri adetini bulma

ÖmerFaruk

ÖmerFaruk

Destek Ekibi
Destek Ekibi
Katılım
22 Ekim 2017
Mesajlar
4,655
Excel Vers. ve Dili
Microsoft 365 Tr-64
Kodlarınızda son For döngüsünden sonra aşağıda gösterdiğim gibi 2 satırı ilave edin.
C++: 
            For musteri = bolge To son
                If s1.Cells(musteri, "C") = bolgeadi Then
                    musteriadi = s1.Cells(musteri, "A")
                    musteritutar = s1.Cells(musteri, "B")
                    yeni1 = s2.Cells(Rows.Count, sutun).End(3).Row + 1
                    s2.Cells(yeni1, sutun) = musteriadi
                    s2.Cells(yeni1, sutun + 1) = musteritutar
                    's2.Range(Cells(yeni1, sutun), Cells(yeni1, sutun + 2)).Interior.Color = RGB(243, 236, 222)
                    s2.Range(Cells(yeni1, sutun), Cells(yeni1, sutun + 1)).Font.Bold = True
                    s2.Range(Cells(yeni1, sutun), Cells(yeni1, sutun + 1)).Borders.LineStyle = 1
                    s2.Range(Cells(yeni1, sutun), Cells(yeni1, sutun + 1)).Borders.Color = RGB(221, 198, 157)
                    s2.Range(Cells(yeni1, sutun), Cells(yeni1, sutun)).HorizontalAlignment = xlLeft
                    s2.Range(Cells(yeni1, sutun), Cells(yeni1, sutun)).VerticalAlignment = xlCenter
                    s2.Range(Cells(yeni1, sutun + 1), Cells(yeni1, sutun + 1)).HorizontalAlignment = xlCenter
                    s2.Range(Cells(yeni1, sutun + 1), Cells(yeni1, sutun + 1)).VerticalAlignment = xlCenter
                    s2.Range(Cells(yeni1, sutun + 1), Cells(yeni1, sutun + 1)).NumberFormat = "#,##0.00"
                End If
            Next
            '.......................ilave 2 satır
            s2.Cells(yeni1 + 2, sütun) = "Müşteri Sayısı"
            s2.Cells(yeni1 + 2, sütun + 1) = yeni1 - 7
 
veyselemre

veyselemre

Özel Üye
Katılım
9 Mart 2005
Mesajlar
3,582
Excel Vers. ve Dili
Pro Plus 2021
Kod: 
Sub test()
    Dim s1 As Worksheet, s2 As Worksheet, w(1 To 2), y(), i, son&, bolge$, sut&
    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
    
    sut = -2
    Rows(5).RowHeight = 23
    
    With CreateObject("Scripting.Dictionary")
        
        For i = 2 To son
            bolge = s1.Cells(i, 3).Value
            If Not .exists(bolge) Then
                sut = sut + 3
                w(1) = sut
                w(2) = 0
                .Item(bolge) = w
                Columns(sut + 2).ColumnWidth = 3
                
                s2.Cells(5, sut).Resize(, 2).Value = Array(bolge, "CİRO ARALIĞI")
                s2.Cells(7, sut).Resize(, 2).Value = Array("MÜŞTERİ", "CİRO TUTARI")
                
                With s2.Cells(5, sut).Resize(3, 2).SpecialCells(xlCellTypeConstants)
                    .Interior.Color = RGB(200, 159, 93)
                    .Font.Color = RGB(255, 255, 255)
                    .HorizontalAlignment = xlCenter
                    With .Cells(2)
                        .Interior.Color = RGB(221, 198, 157)
                        .Font.Color = RGB(0, 0, 0)
                    End With
                End With
                
            End If
            
            y = .Item(bolge)
            
            With s2.Cells(y(2) + 8, y(1)).Resize(, 2)
                .Value = s1.Cells(i, 1).Resize(, 2).Value
            End With
           
            y(2) = y(2) + 1
            .Item(bolge) = y
            If y(2) > mx Then mx = y(2)
        
        Next i
        y = .items
       
        For Each i In y
            With s2.Cells(8, i(1))
                .Offset(i(2) + 1).Resize(, 2).Value = Array("Müşteri Sayısı", i(2))
                With .Resize(i(2) + 2, 2).SpecialCells(xlCellTypeConstants)
                    .Borders.LineStyle = 1
                    .Borders.Color = RGB(221, 198, 157)
                    .HorizontalAlignment = xlCenter
                    .EntireColumn.AutoFit
                End With
                .Resize(i(2)).HorizontalAlignment = xlLeft
                .Offset(, 1).Resize(i(2)).NumberFormat = "#,##0.00"
            End With
        Next
        
        With s2.Range(s2.Cells(5, 1), s2.Cells(mx + 10, sut + 2)).SpecialCells(xlCellTypeConstants)
            .VerticalAlignment = xlCenter
            .Font.Bold = True
        End With

        Columns(4).ColumnWidth = Columns(1).ColumnWidth
    End With
    
    Application.ScreenUpdating = False

End Sub
 
Son düzenleme:
K

koboy

Altın Üye
Katılım
1 Ağustos 2006
Mesajlar
179
Altın Üyelik Bitiş Tarihi
22-08-2024
ÖmerFaruk' Alıntı:
Kodlarınızda son For döngüsünden sonra aşağıda gösterdiğim gibi 2 satırı ilave edin.
C++: 
            For musteri = bolge To son
                If s1.Cells(musteri, "C") = bolgeadi Then
                    musteriadi = s1.Cells(musteri, "A")
                    musteritutar = s1.Cells(musteri, "B")
                    yeni1 = s2.Cells(Rows.Count, sutun).End(3).Row + 1
                    s2.Cells(yeni1, sutun) = musteriadi
                    s2.Cells(yeni1, sutun + 1) = musteritutar
                    's2.Range(Cells(yeni1, sutun), Cells(yeni1, sutun + 2)).Interior.Color = RGB(243, 236, 222)
                    s2.Range(Cells(yeni1, sutun), Cells(yeni1, sutun + 1)).Font.Bold = True
                    s2.Range(Cells(yeni1, sutun), Cells(yeni1, sutun + 1)).Borders.LineStyle = 1
                    s2.Range(Cells(yeni1, sutun), Cells(yeni1, sutun + 1)).Borders.Color = RGB(221, 198, 157)
                    s2.Range(Cells(yeni1, sutun), Cells(yeni1, sutun)).HorizontalAlignment = xlLeft
                    s2.Range(Cells(yeni1, sutun), Cells(yeni1, sutun)).VerticalAlignment = xlCenter
                    s2.Range(Cells(yeni1, sutun + 1), Cells(yeni1, sutun + 1)).HorizontalAlignment = xlCenter
                    s2.Range(Cells(yeni1, sutun + 1), Cells(yeni1, sutun + 1)).VerticalAlignment = xlCenter
                    s2.Range(Cells(yeni1, sutun + 1), Cells(yeni1, sutun + 1)).NumberFormat = "#,##0.00"
                End If
            Next
            '.......................ilave 2 satır
            s2.Cells(yeni1 + 2, sütun) = "Müşteri Sayısı"
            s2.Cells(yeni1 + 2, sütun + 1) = yeni1 - 7
Genişletmek için tıkla ...
Teşekkür ederim yarın deneyecem elinize sağlık
 
K

koboy

Altın Üye
Katılım
1 Ağustos 2006
Mesajlar
179
Altın Üyelik Bitiş Tarihi
22-08-2024
veyselemre' Alıntı:
Kod: 
Sub test()
    Dim s1 As Worksheet, s2 As Worksheet, w(1 To 2), y(), i, son&, bolge$, sut&
    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
   
    sut = -2
    Rows(5).RowHeight = 23
   
    With CreateObject("Scripting.Dictionary")
       
        For i = 2 To son
            bolge = s1.Cells(i, 3).Value
            If Not .exists(bolge) Then
                sut = sut + 3
                w(1) = sut
                w(2) = 0
                .Item(bolge) = w
                Columns(sut + 2).ColumnWidth = 3
               
                s2.Cells(5, sut).Resize(, 2).Value = Array(bolge, "CİRO ARALIĞI")
                s2.Cells(7, sut).Resize(, 2).Value = Array("MÜŞTERİ", "CİRO TUTARI")
               
                With s2.Cells(5, sut).Resize(3, 2).SpecialCells(xlCellTypeConstants)
                    .Interior.Color = RGB(200, 159, 93)
                    .Font.Color = RGB(255, 255, 255)
                    .HorizontalAlignment = xlCenter
                    With .Cells(2)
                        .Interior.Color = RGB(221, 198, 157)
                        .Font.Color = RGB(0, 0, 0)
                    End With
                End With
               
            End If
           
            y = .Item(bolge)
           
            With s2.Cells(y(2) + 8, y(1)).Resize(, 2)
                .Value = s1.Cells(i, 1).Resize(, 2).Value
            End With
          
            y(2) = y(2) + 1
            .Item(bolge) = y
            If y(2) > mx Then mx = y(2)
       
        Next i
        y = .items
      
        For Each i In y
            With s2.Cells(8, i(1))
                .Offset(i(2) + 1).Resize(, 2).Value = Array("Müşteri Sayısı", i(2))
                With .Resize(i(2) + 2, 2).SpecialCells(xlCellTypeConstants)
                    .Borders.LineStyle = 1
                    .Borders.Color = RGB(221, 198, 157)
                    .HorizontalAlignment = xlCenter
                    .EntireColumn.AutoFit
                End With
                .Resize(i(2)).HorizontalAlignment = xlLeft
                .Offset(, 1).Resize(i(2)).NumberFormat = "#,##0.00"
            End With
        Next
       
        With s2.Range(s2.Cells(5, 1), s2.Cells(mx + 10, sut + 2)).SpecialCells(xlCellTypeConstants)
            .VerticalAlignment = xlCenter
            .Font.Bold = True
        End With

        Columns(4).ColumnWidth = Columns(1).ColumnWidth
    End With
   
    Application.ScreenUpdating = False

End Sub
Genişletmek için tıkla ...
Teşekkür ederim yarın ilk işim kontrol etmek olacak elinize sağlık
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst