ayın günler sayma ve tabloya atma

[emrebengul]

merahaba üstadlarım;

Aralık ayında günlere göre saydırıp ayın 1inden sonuna kadar kaç adet müşteri varsa sayfa2'ye aktarmak istiyorum.
Örneğin Ankara Bölgesi Ayın 1'inde 2 adet aynı müşteri yazılmış bu sayfa2'ye yazmak istiyorum fakat ama bir türlü çıkamadım destek olur musunuz?
Şimdiden çok teşekkür ederim.

 

[Erkan Akayay]

Bu tablo aylıkmı? Birden fazla ay olacakmı?

 

[emrebengul]

sadece aylık Erkan Bey

 

[Necdet]

Merhaba,

 

[emrebengul]

konu günceldir.

 

[emrebengul]

Necdet Bey öncelikle çok teşekkür ederim ama soruyu güncelliyordum kusura bakmayın aslında sonradan farkettiğim hatayı düzeltmek için güncelliyordum. Müşteri Adına göre adet almak istiyorum aslında. Bunun için destek olma şansınız var mıdır?

 

[Necdet]

Merhaba,
Makroya gerek var mı? Pivot table işinizi görür.

 

[emrebengul]

veri çok olduğundan dolayı pivot baya uzun sürüyor Necdet Bey.
Makro ile daha iyi oluyor yoksa tek tek saymam gerekiyor.

 

[Necdet]

Tek tek saymak hepsinden daha hızlıdır

Sub Deneme()

Dim arr As Variant, _
    diz As Variant, _
    col As New Collection, _
    i   As Long, _
    j   As Long, _
    k   As Long, _
    tar As Date, _
    gun As Integer, _
    yil As Long, _
    ay  As Integer, _
    bir As String, _
    tip As Integer
    
bir = "/"   'Chr(10), /, - gibi karakterler de kullanılabilinir
tip = 0 '0 ya da 1 olmalı. 0->tarih satırda, 1-> Tarih Sütunda Yazdırılır
tar = Sayfa1.Range("A2")
gun = Day(DateSerial(year(tar), month(tar) + 1, 0)) + 1
yil = year(tar)
ay = month(tar)

arr = Sayfa1.Range("A1").CurrentRegion
For i = 2 To UBound(arr, 1)
    arr(i, 2) = arr(i, 2) & bir & arr(i, 3)
Next i

Array_Sort arr, 2, 2

On Error Resume Next

For i = 2 To UBound(arr, 1)
    col.Add arr(i, 2), arr(i, 2)
Next i
On Error GoTo 0

ReDim diz(1 To gun, 1 To col.count + 1)

diz(1, 1) = "Tarih\Müşteri"
For i = 2 To gun
    diz(i, 1) = DateSerial(yil, ay, i - 1)
Next i

For i = 1 To col.count
    diz(1, i + 1) = col.Item(i)
Next i

For i = 2 To UBound(arr, 1)
    gun = Day(arr(i, 1)) + 1
    For j = 2 To UBound(diz, 2)
        If arr(i, 2) = diz(1, j) Then Exit For
    Next j
    diz(gun, j) = diz(gun, j) + 1
Next i

With Sayfa2
    .Range("A1").CurrentRegion.ClearContents
    If tip = 0 Then
        .Range("A1").Resize(UBound(diz, 1), UBound(diz, 2)) = diz
    Else
        .Range("A1").Resize(UBound(diz, 2), UBound(diz, 1)) = Application.WorksheetFunction.Transpose(diz)
    End If
End With

Sayfa2.Select

MsgBox "İşlem Tamamdır....", vbInformation, "www.excel.web.tr --> Necdet"

End Sub

Public Function Array_Sort(ByRef sortArray As Variant, _
                           Optional firstRow As Long = 1, _
                           Optional searchCol As Integer = 1, _
                           Optional numericSort As Boolean = False, _
                           Optional ascendingOrder As Boolean = True) As Variant()

Dim temp As Variant
Dim lastRow As Long
Dim firstCol As Long
Dim lastCol As Long
Dim i As Long
Dim j As Long
Dim k As Long

lastRow = UBound(sortArray, 1)
firstCol = LBound(sortArray, 2)
lastCol = UBound(sortArray, 2)
For i = firstRow To lastRow - 1
    For j = i + 1 To lastRow
        If (numericSort And ascendingOrder And sortArray(i, searchCol) > sortArray(j, searchCol)) _
        Or (Not (numericSort) And ascendingOrder And StrComp(sortArray(i, searchCol), sortArray(j, searchCol)) = 1) _
        Or (numericSort And Not (ascendingOrder) And sortArray(i, searchCol) < sortArray(j, searchCol)) _
        Or (Not (numericSort) And Not (ascendingOrder) And StrComp(sortArray(i, searchCol), sortArray(j, searchCol)) = -1) Then
            For k = firstCol To lastCol
                temp = sortArray(j, k)
                sortArray(j, k) = sortArray(i, k)
                sortArray(i, k) = temp
            Next k
        End If
    Next j
Next i

Array_Sort = sortArray

End Function

 

[emrebengul]

Necdet Bey Teşekkür ederim ama bunu isim olarak ayırmak yerine sadece adana olarak değer atma şansımız var mıdır? ve 2 defa yazılan metni 1 defa alsın istiyorum. Bunlara yardım etme şansınız varsa çok iyi olur gerçekten

 

[Necdet]

hiç bir şey anlamadım.

 

[emrebengul]

Necdet Bey size vermiş olduğunuz isimleri şehirlere göre alıyor.

Benim ise yapmak istediğim şey şöyle bir şey.



Cünkü 35000 tane veri var takip açısından böyle daha iyi olur diye düşünüyorum.
İnşallah analatabilmişimdir

 

[Necdet]

Necdet Bey öncelikle çok teşekkür ederim ama soruyu güncelliyordum kusura bakmayın aslında sonradan farkettiğim hatayı düzeltmek için güncelliyordum. Müşteri Adına göre adet almak istiyorum aslında. Bunun için destek olma şansınız var mıdır?

Bu mesajınızda müşterilere göre toplam almak istiyorum demiştiniz?
ben de uğraştım müşteriye göre düzenledim, şimdi şehir diyorsunuz.
hangisi? ki ilk önerim zaten son istediğiniz gibi idi.

 

[emrebengul]

Necdet Bey Adana Bölgesinde isimlere göre kaç adet olduğunu görmek istiyorum. Çünkü Bazı isimler aynı tarihte 2 defa yazılmış. Yani Ben Müşteri isimlerini değilde 01.12.2022 tarihinde Adana Bölgede 2 adet farklı isim varsa sayfa2'de Adana shiftinin altına 2 yazmasını istiyorum.

 

[Necdet]

Tamam da illk sorunuz zaten öyleydi, ve ilk yanıtı da o şekilde vermiştim.
sonra müşteri vs dediniz sonra yine ilk sorduğunuz gibi istiyorsunuz.
O zaman ilk yanıtı kullanın derim.