Aynı hücrede adet kg ayrı ayrı toplama

[carlos33]

AYNI EXCEL HÜCRESİNDE Örneğin 20 adet , 25 adet , 10 kg,15 kg yazıyor
bunu ayrı ayrı toplamasını istiyorum 45 adet 25 kg yazmasını istiyorum .

 

[Ömer BARAN]

Merhaba, foruma hoşgeldiniz.

Veri yığınının miktarını bilemiyorum ama tavsiyem;
--önce "," (virgül) karakterine göre, VERİ menüsündeki METNİ SÜTUNLARA DÖNÜŞTÜR işlemini yapmanız,
--ardından da verinin dağıldığı sütunlardaki veriler üzerinden de formül ile dğerleri toplamanız,
yönünde olacak.

Sorunuza, oluşturulacak dizi formülüyle çözüm oluşturulabilir sanırım ama veri yığınının boyutuna göre bu yöntem verimli olmayabilir.

Eğer verileri kendiniz oluşturuyorsanız bırakın tek bir hücreyi,
sütunları aynı tür veriler için kullanmanız (veri tabanı mantığıyla) her zaman tüm işlemlerinizde kolaylık sağlayacaktır.

Verileri kendiniz oluşturmayıp, başka bir programdan/kaynaktan hazır alıyorsanız;
yukarıda belirttiğim sütunlara dönüştürme işlemini, verileri alma aşamasında makro kullanarak yapmanız kullanışlı olabilir.

Sorunuzu; --cevabımın altındaki İMZA bölümündeki açıklamalar doğrultusunda hazırlayacağınız--
bir örnek belge üzerinden sormanız halinde daha hızlı sonuca ulaşabilirsiniz diye düşünüyorum.
.

 

[carlos33]

örnek dosya ektedir http://s2.dosya.tc/server3/0jundg/indKdvDetay.xls.html

http://s2.dosya.tc/server3/0jundg/indKdvDetay.xls.html

 

[Ziynettin]

Sn carlos33, toplamların yazılacağı sütunu belirtmemişsiniz. Toplamlar [O] sütununa yazdırıldı.
Aşağıdaki kod içinde kırmızı yazlı satırda olmayan birimleri eklemeyi unutmayınız.

Sub Birim_Topla()
Application.ScreenUpdating = False
On Error Resume Next
Sheets("Page1").Select
veri = Range("H5:H" & Cells(Rows.Count, "H").End(3).Row)
Set VBR = CreateObject("vbscript.regexp")
VBR.Global = True
Birim = Array([COLOR="Red"]"ADET", "LİTRE", "KG", "TAKIM"[/COLOR])
    ReDim b(1 To UBound(veri), 1 To UBound(Birim) + 1)
    For x = 1 To UBound(veri)
        say = say + 1
        For h = 0 To UBound(Birim)
            VBR.Pattern = "\d+(,|\.)*\d{0,9}\s*(" & Birim(h) & ")"
            Set a = VBR.Execute(veri(x, 1))
            Top = 0
            For i = 0 To a.Count - 1
                Top = Top + Val(Replace(a(i), ",", "."))
                toplam = Top & " " & Birim(h)
                b(say, h + 1) = toplam
            Next i
        Next h
    Next x
    tbl = Array(b)
    ReDim s(1 To UBound(veri), 1 To 1)
    say = 0
    For i = 1 To UBound(veri)
        say = say + 1
        For p = 1 To UBound(Birim) + 1
            If tbl(0)(i, p) <> "" Then
                bb = bb & " " & tbl(0)(i, p) & ",  "
                s(say, 1) = Left(bb, Len(bb) - 3)
            End If
        Next p
        bb = Empty
    Next i
Range("H5:H" & Rows.Count).ClearContents
If say > 0 Then
    [O5].Resize(say) = s
End If
Application.ScreenUpdating = True
MsgBox "İşlem tamam.....", vbInformation
End Sub

http://s3.dosya.tc/server9/moxh0m/indkdv.rar.html

 

[carlos33]

Teşekkürler hocam büyük bir sıkıntıdan kurtardınız

 

[Ziynettin]

Rica ederim.
İyi çalışmalar...

 

[carlos33]

http://s2.dosya.tc/server3/blfimt/MAAS_CIZELGESI_2016.xlsx.html

ekteki listede ay içindeki gelmedikleri günler yazıyor istediğim listenin sonunda gelmedikleri gün tek sütünda yazdırabilir misiniz?
mesela ahmet atmaca cv sutununa 1,2,12 yazmasını istiyorum

 

[Merhum İdris SERDAR]

http://s2.dosya.tc/server3/blfimt/MAAS_CIZELGESI_2016.xlsx.html

ekteki listede ay içindeki gelmedikleri günler yazıyor istediğim listenin sonunda gelmedikleri gün tek sütünda yazdırabilir misiniz?
mesela ahmet atmaca cv sutununa 1,2,12 yazmasını istiyorum

.

Yeni bir başlık altında konuyu açmalısınız.

.