benzersizleri saydırma

[aydgur]

i günler dilerim bı kod yardımı ile usd toplamını aldım fakat 4 yapmama rağmen eur sütününa getiremedim ne yapmalıyım ?

 

[Korhan Ayhan]

Merhaba,

Aşağıdaki satırdaki 3 değerini 4 yaparak deneyiniz.

sh.Range("H2").Resize(z.Count, 3).Value = Application.Transpose(b)

 

[aydgur]

Korhan bey geç döndüğüm için kusura bakmayın . Yardımınız için çok çok teşekkür ederim.

 

[aydgur]

Korhan bey ayıp olmazsa bir ricam daha olacak 4 leri 5 yaparsam yandaki sütünü da ekleyebilir miyim?

 

[Korhan Ayhan]

Deneyin bakalım oluyor mu?

 

[aydgur]

Bu şekilde yazdım ama olmadı
Sub benzersiz_yeni()

Dim sh As Worksheet, ss As Long, z As Object, a, b(), i As Long, n As Long
Dim aranan As String

Set sh = Sheets("VADEYE GÖRE SATIŞLAR")
ss = sh.Range("C" & Rows.Count).End(4).Row
Set z = CreateObject("Scripting.Dictionary")
z.comparemode = vbTextCompare
ReDim b(1 To 5, 1 To 1)
n = 0
a = sh.Range("C2:G" & ss).Value
For i = 1 To UBound(a, 1)
If a(i, 1) <> "" Then
aranan = a(i, 1)
If Not z.exists(aranan) Then
n = n + 1
z.Add aranan, n
ReDim Preserve b(1 To 5, 1 To n)
b(1, n) = a(i, 1)
b(2, n) = a(i, 2) * 1
b(3, n) = a(i, 3) * 1
b(4, n) = a(i, 4) * 1
b(5, n) = a(i, 5) * 1
Else
b(2, z.Item(aranan)) = b(2, z.Item(aranan)) * 1 + a(i, 2) * 1
b(3, z.Item(aranan)) = b(3, z.Item(aranan)) * 1 + a(i, 3) * 1
b(4, z.Item(aranan)) = b(4, z.Item(aranan)) * 1 + a(i, 4) * 1
b(5, z.Item(aranan)) = b(5, z.Item(aranan)) * 1 + a(i, 5) * 1
End If
End If
Next i
sh.Range("H1").Value = "Benzersiz Vade Günü"
sh.Range("I1").Value = "Toplam TL"
sh.Range("J1").Value = "Toplam USD"
sh.Range("K1").Value = "Toplam EUR"
sh.Range("L1").Value = "Gün Sayısı"

sh.Range("H2:L" & Rows.Count).ClearContents
sh.Range("H2:L" & Rows.Count).Borders.LineStyle = xlNone
sh.Range("H2").Resize(z.Count, 5).Value = Application.Transpose(b)
With sh.Range("H2:L50" & z.Count)
.Borders.LineStyle = 1
.Font.Name = "Calibri"
.Font.Size = 10
End With
MsgBox "İşlem tamamlandı.", vbInformation, "antonio"
End Sub

 

[Korhan Ayhan]

Peki ne oldu?

 

[aydgur]

tür uyumsuz diyor

 

[Korhan Ayhan]

Hangi satır için bunu diyor. Sanırım tablonuzda BOŞ hücreler var. Onları düzeltirseniz sorun düzelebilir.

 

[aydgur]

kusura bakmayın ben anlatamadım. birinci kod ile sayıyor ama G sütünunuda L sütununa toplatmak için 2.kod hata verdi nerede değişiklik gerekiyor yardım etmeniz mümkün mü?

 

[Korhan Ayhan]

Neden görsel paylaşıyorsunuz..

Altın üyesiniz. Dosya paylaşabilirsiniz.

 

[aydgur]

Dosyayı hemen paylaşıyorum Korhan bey

 

[aydgur]

Korhan bey sizi darlamış gibi olmayayım da yardımcı olmanız mümkün mü?

 

[Korhan Ayhan]

Formül sonlarında "" kullanımı ile hücreyi BOŞ göstermişsiniz. Daha sonra makroda bu hücreleri HÜCRE * 1 şeklinde işlem yaptırıyorsunuz. Bu işlem BOŞ hücreye geldiğinde hata oluşmasına sebep oluyor. IF ya da IIF komutları ile durumu kontrol altına almanız gerekiyor.

Sub Pivot_Report()
    Dim sh As Worksheet, ss As Long
    Dim z As Object, a, i As Long
    Dim n As Long, aranan As String
    
    Set sh = Sheets("VADEYE GÖRE SATIŞLAR")
    Set z = CreateObject("Scripting.Dictionary")
    
    ss = sh.Range("C" & Rows.Count).End(3).Row
    z.comparemode = vbTextCompare
    
    ReDim b(1 To 5, 1 To 1)
    n = 0
    a = sh.Range("C2:G" & ss).Value
    
    For i = 1 To UBound(a, 1)
        If a(i, 1) <> "" Then
            aranan = a(i, 1)
            If Not z.exists(aranan) Then
                n = n + 1
                z.Add aranan, n
                ReDim Preserve b(1 To 5, 1 To n)
                b(1, n) = a(i, 1)
                b(2, n) = IIf(a(i, 2) = "", 0, a(i, 2)) * 1
                b(3, n) = IIf(a(i, 3) = "", 0, a(i, 3)) * 1
                b(4, n) = IIf(a(i, 4) = "", 0, a(i, 4)) * 1
                b(5, n) = IIf(a(i, 5) = "", 0, a(i, 5)) * 1
            Else
                b(2, z.Item(aranan)) = b(2, z.Item(aranan)) * 1 + a(i, 2) * 1
                b(3, z.Item(aranan)) = b(3, z.Item(aranan)) * 1 + a(i, 3) * 1
                b(4, z.Item(aranan)) = b(4, z.Item(aranan)) * 1 + a(i, 4) * 1
                b(5, z.Item(aranan)) = b(5, z.Item(aranan)) * 1 + IIf(a(i, 5) = "", 0, a(i, 5)) * 1
            End If
        End If
    Next i
    
    sh.Range("H1").Value = "Benzersiz Malzeme Adı"
    sh.Range("I1").Value = "Toplam TL"
    sh.Range("J1").Value = "Toplam USD"
    sh.Range("K1").Value = "Toplam EUR"
    sh.Range("L1").Value = "Toplam GÜN"
    
    sh.Range("H2:L" & Rows.Count).Clear
    sh.Range("I2:L" & Rows.Count).NumberFormat = "#,##0.00"
    sh.Range("H2").Resize(z.Count, 5).Value = Application.Transpose(b)
    
    With sh.Range("H2:L" & z.Count + 1)
        .Borders.LineStyle = 1
        .Font.Name = "Calibri"
        .Font.Size = 10
    End With
    
    Set sh = Nothing
    Set z = Nothing
    
    MsgBox "İşlem tamamlandı.", vbInformation, "antonio"
End Sub

 

[aydgur]

Anladım Korhan bey, Değerli vaktinizi ayırıp yardımcı olduğunuz için müteşekkirim