İsimleri sadece bir kere yazdırabilmek

[aydgur]

c sütününda malzeme adları var . benim yapmak istediğim
her biri ayrı ayrı tarihlerde satılan malzemelerin adlarını
h sütününa her malzeme cinsini sadece bir kere yazdırmak.
Bunu formül yada makro ile nasıl yapabilirim ?

 

[çıtır]

Formülle; İsimler C2 başladığı varsayılmıştır.H2 Kopyalayınız.Formül cubuğuna tıklayıp ctrl ve shift tuşlarına basılı iken enter tuşlayınız.Başta { sonda } işareti oluşmalı sonra ihtiyaç kadar aşağı çekiniz.Dizi formülü.1 kez alır.

=EĞERHATA(İNDİS(C$2:C$100;KAÇINCI(;EĞERSAY($H$1:H1;C$2:C$100);0);1);"")

 

[antonio]

Merhaba,
Benzersiz veriler listesi ile bu verilere ait toplam tl ve euro değerlerini de getirecek şekilde kod oluşturdum. Kodlarınız aşağıda, dosyanız ektedir.

Sub verileri_benzersiz_yazdir()
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("Sayfa3")
ss = sh.Range("C" & Rows.Count).End(3).Row
Set z = CreateObject("Scripting.Dictionary")
    z.comparemode = vbTextCompare
    ReDim b(1 To 3, 1 To 1)
    n = 0
    a = sh.Range("C2:E" & 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 3, 1 To n)
                b(1, n) = a(i, 1)
                b(2, n) = a(i, 2) * 1
                b(3, n) = a(i, 3) * 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
            End If
        End If
    Next i
    sh.Range("H1").Value = "Benzersiz Malzeme Adı"
    sh.Range("I1").Value = "Toplam TL"
    sh.Range("J1").Value = "Toplam EUR"
    
    sh.Range("H2:J" & Rows.Count).ClearContents
    sh.Range("H2:J" & Rows.Count).Borders.LineStyle = xlNone
    sh.Range("H2").Resize(z.Count, 3).Value = Application.Transpose(b)
    With sh.Range("H2:J" & z.Count)
            .Borders.LineStyle = 1
            .Font.Name = "Calibri"
            .Font.Size = 10
    End With
    MsgBox "İşlem tamamlandı.", vbInformation, "antonio"
End Sub

 

[aydgur]

İyi akşamlar , çok teşekkür ederim.
=EĞER(K3="TL";J3);EĞER(K3="EUR";J3*G3;EĞER(K3="USD";K3*G4)) Bu formül DEĞER hatası veriyor , nasıl engelleyebilirim ?