mükerrer kayıtların , farklı toplamları

[ankara34]

selamlar arkadaşlar ,

excelde örnek dosyada ekledim.

STOK.xlsx dosyasını indir - download

STOK.xlsx dosyasını indir, download. Dosya.tc .Dosya Upload. Dosya Paylaş. Dosya Yükle

s6.dosya.tc

tabloda
A sutununda sayısal , B ve C de string , D de sayısal değerlerim var,

D sutunu 23 ise B sutunundaki isimleri baz alarak , A sutunundaki toplamlarını J sutununa , aynıi şekilde I sutununa benzersiz isimlerini yazdırmak istiyorum.
D sutunu 88 ise C sutunundaki isimleri baz alarak, A sutunundaki toplamlarını J sutununa , aynıi şekilde I sutununa benzersiz isimlerini yazdırmak istiyorum.

VBA ile kodu yazabilirseniz sevinirim..

saygılarımla kolay gelsin..

 

[cems]

https://s6.dosya.tc/server20/bowc8f/STOK.xlsm.html Dosyanız makro kod kabul etmesi için .xlsm ye dönüştürüldü ve bir çalıştır düğmesi elendi


Sub ToplamVeBenzersizIsimleriHesapla()
Dim ws As Worksheet
Dim lastRow As Long
Dim i As Long
Dim dict As Object
Dim key As Variant


Set ws = ThisWorkbook.Sheets("STOK")

lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

Set dict = CreateObject("Scripting.Dictionary")


For i = 2 To lastRow
If ws.Cells(i, "D").Value = 23 Then
If Not dict.exists(ws.Cells(i, "B").Value) Then
dict.Add ws.Cells(i, "B").Value, ws.Cells(i, "A").Value
Else
dict(ws.Cells(i, "B").Value) = dict(ws.Cells(i, "B").Value) + ws.Cells(i, "A").Value
End If
ElseIf ws.Cells(i, "D").Value = 88 Then
If Not dict.exists(ws.Cells(i, "C").Value) Then
dict.Add ws.Cells(i, "C").Value, ws.Cells(i, "A").Value
Else
dict(ws.Cells(i, "C").Value) = dict(ws.Cells(i, "C").Value) + ws.Cells(i, "A").Value
End If
End If
Next i

For Each key In dict.keys
ws.Cells(ws.Rows.Count, "J").End(xlUp).Offset(1, 0).Value = dict(key)
ws.Cells(ws.Rows.Count, "I").End(xlUp).Offset(1, 0).Value = key
Next key

Set dict = Nothing
End Sub



Deneyiniz

 

[ankara34]

https://s6.dosya.tc/server20/bowc8f/STOK.xlsm.html Dosyanız makro kod kabul etmesi için .xlsm ye dönüştürüldü ve bir çalıştır düğmesi elendi


Sub ToplamVeBenzersizIsimleriHesapla()
Dim ws As Worksheet
Dim lastRow As Long
Dim i As Long
Dim dict As Object
Dim key As Variant


Set ws = ThisWorkbook.Sheets("STOK")

lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

Set dict = CreateObject("Scripting.Dictionary")


For i = 2 To lastRow
If ws.Cells(i, "D").Value = 23 Then
If Not dict.exists(ws.Cells(i, "B").Value) Then
dict.Add ws.Cells(i, "B").Value, ws.Cells(i, "A").Value
Else
dict(ws.Cells(i, "B").Value) = dict(ws.Cells(i, "B").Value) + ws.Cells(i, "A").Value
End If
ElseIf ws.Cells(i, "D").Value = 88 Then
If Not dict.exists(ws.Cells(i, "C").Value) Then
dict.Add ws.Cells(i, "C").Value, ws.Cells(i, "A").Value
Else
dict(ws.Cells(i, "C").Value) = dict(ws.Cells(i, "C").Value) + ws.Cells(i, "A").Value
End If
End If
Next i

For Each key In dict.keys
ws.Cells(ws.Rows.Count, "J").End(xlUp).Offset(1, 0).Value = dict(key)
ws.Cells(ws.Rows.Count, "I").End(xlUp).Offset(1, 0).Value = key
Next key

Set dict = Nothing
End Sub



Deneyiniz

Sn. cems
makro toplamlarında hatalar var , manuel topladıklarımda uyuşmadı,
ek olarak stok kodunu ilave edebilirmisiniz teşekkür ederim.

altta sonuçları karşılaştırdım, gerçi biraz karışık oldu

frm.png dosyasını indir - download

frm.png dosyasını indir, download. Dosya.tc .Dosya Upload. Dosya Paylaş. Dosya Yükle

s6.dosya.tc

 

[cems]

deneyiniz

STOK.xlsm dosyasını indir - download

STOK.xlsm dosyasını indir, download. Dosya.tc .Dosya Upload. Dosya Paylaş. Dosya Yükle

s6.dosya.tc

Bu arada uyuşmama sebebi :

ALAMA BUFE

ALAMA BÜFE

Bu şekilde farklı büfe olarak algılanabilir, tablonuzda gerekli elle duzeltmeleri yapmalısınız

 

[veyselemre]

vba =>

Sub test()
    Dim v, i, say, ky, ky1, ky2, sira

    v = Range("A2:D" & Cells(Rows.Count, 1).End(3).Row).Value
    With CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(v)
            If v(i, 4) = 23 Then
                ky1 = Trim(v(i, 2))
                ky2 = "23"
            Else
                ky1 = Trim(v(i, 3))
                ky2 = "88"
            End If
            ky = ky1 & "-" & ky2
            If Not .exists(ky) Then
                say = say + 1
                v(say, 2) = v(i, 1)
                v(say, 1) = ky1
                v(say, 3) = ky2
                .Item(ky) = say
            Else
                sira = .Item(ky)
                v(sira, 2) = v(sira, 2) + v(i, 1)
            End If
        Next i
    End With
    Range("I2:K" & Rows.Count).ClearContents
    Range("I2").Resize(say, 3).Value = v
End Sub

Power Query =>

let
  Kaynak = Excel.CurrentWorkbook(){[Name = "Tablo1"]}[Content],
  #"Değiştirilen Tür" = Table.TransformColumnTypes(
    Kaynak,
    {
      {"kilo", Int64.Type},
      {"alan market", type text},
      {"satan market", type text},
      {"STOK KOD", Int64.Type}
    }
  ),
  #"Özel Eklendi" = Table.AddColumn(
    #"Değiştirilen Tür",
    "Market",
    each if [STOK KOD] = 23 then [alan market] else [satan market]
  ),
  #"Gruplanan Satırlar" = Table.Group(
    #"Özel Eklendi",
    {"STOK KOD", "Market"},
    {{"Toplam Kilo", each List.Sum([kilo]), type nullable number}}
  ),
  #"Yeniden Sıralanan Sütunlar" = Table.ReorderColumns(
    #"Gruplanan Satırlar",
    {"Market", "Toplam Kilo", "STOK KOD"}
  )
in
  #"Yeniden Sıralanan Sütunlar"

 

[ankara34]

vba =>

Sub test()
    Dim v, i, say, ky, ky1, ky2, sira

    v = Range("A2:D" & Cells(Rows.Count, 1).End(3).Row).Value
    With CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(v)
            If v(i, 4) = 23 Then
                ky1 = Trim(v(i, 2))
                ky2 = "23"
            Else
                ky1 = Trim(v(i, 3))
                ky2 = "88"
            End If
            ky = ky1 & "-" & ky2
            If Not .exists(ky) Then
                say = say + 1
                v(say, 2) = v(i, 1)
                v(say, 1) = ky1
                v(say, 3) = ky2
                .Item(ky) = say
            Else
                sira = .Item(ky)
                v(sira, 2) = v(sira, 2) + v(i, 1)
            End If
        Next i
    End With
    Range("I2:K" & Rows.Count).ClearContents
    Range("I2").Resize(say, 3).Value = v
End Sub

Power Query =>

let
  Kaynak = Excel.CurrentWorkbook(){[Name = "Tablo1"]}[Content],
  #"Değiştirilen Tür" = Table.TransformColumnTypes(
    Kaynak,
    {
      {"kilo", Int64.Type},
      {"alan market", type text},
      {"satan market", type text},
      {"STOK KOD", Int64.Type}
    }
  ),
  #"Özel Eklendi" = Table.AddColumn(
    #"Değiştirilen Tür",
    "Market",
    each if [STOK KOD] = 23 then [alan market] else [satan market]
  ),
  #"Gruplanan Satırlar" = Table.Group(
    #"Özel Eklendi",
    {"STOK KOD", "Market"},
    {{"Toplam Kilo", each List.Sum([kilo]), type nullable number}}
  ),
  #"Yeniden Sıralanan Sütunlar" = Table.ReorderColumns(
    #"Gruplanan Satırlar",
    {"Market", "Toplam Kilo", "STOK KOD"}
  )
in
  #"Yeniden Sıralanan Sütunlar"

vba => dediğinizi yükledim ama
Power Query =>dediğiniz kod parçasını nereye yazacağımı bilemedi.
size kolay bana zor , cahilliğimi mazur görün lütfen
yüklediğiniz dosyaları altın üye değilim indiremedim.
mümkünse dosya.tc ye yükleyebilirmisiniz.

teşekkür ederim elinize sağlık..