• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Aynı satırları toplayarak birleştirme

H

hakansali

Katılım
10 Eylül 2011
Mesajlar
29
Excel Vers. ve Dili
türkçe
Selamlar arkadaşlar,
bir makro formül dizinimin içine şöyle bir konu için formül gerekti;

1.sütunda olan aynı kodların 4.sütundaki değerlerinin toplanarak 1 satırda görünmesi;
yani

veri;
1.sütun 2.sütun
1452 2
1612 3
1214 1
1452 4
1214 5


sonuç;
1.sütun 2.sütun
1452 6
1612 3
1214 6

olacak...
Yardımı olanlara şimdiden teşekkürler (not; excel 2003 için..)
 
Özet tablo ile yapabilirsiniz...
 
Ilgili formülü gerekli, dediğiniz ile karşıma tablo çıkıyor.. çıkamadım işin içinden..
 
Maça yetişmem lâzım o yüzden kontrol etmedim.
Siz bir deneyip sonucu bildirirsiniz...

Kod: 
Sub murat()
    Dim con As Object, rs As Object
    Set con = CreateObject("Adodb.connection")
    Set rs = CreateObject("Adodb.recordset")
    Range("C2:c10").ClearContents
    con.Open "provider=microsoft.jet.oledb.4.0;data source=" & ThisWorkbook.FullName & _
    ";extended properties=""Excel 8.0;hdr=yes"""
    sorgu = "Select distinct Rakamlar from [Sayfa1$]"
    rs.Open sorgu, con, 1, 1
    Range("C65536").End(3)(1, 1).CopyFromRecordset rs
    rs.Close: con.Close: Columns.AutoFit
    Set con = Nothing: Set rs = Nothing
End Sub
 

Ekli dosyalar

Selamlar,

Dün yolladığım dosyada etopla işlemini formülle yapmıştım. Şimdi koda ilave ettim.
Dilerseniz aşağıdaki dosyayı kullanabilirsiniz;


Kod: 
Sub murat()
    Dim con As Object, rs As Object
    Set con = CreateObject("Adodb.connection")
    Set rs = CreateObject("Adodb.recordset")
    Range("C2:c10").ClearContents
    con.Open "provider=microsoft.jet.oledb.4.0;data source=" & _
    ThisWorkbook.FullName & ";extended properties=""Excel 8.0;hdr=yes"""
    sorgu = "Select distinct Rakamlar, sum(Değer) from [Sayfa1$] group by Rakamlar "
    rs.Open sorgu, con, 1, 1
    Range("C65536").End(3)(2, 1).CopyFromRecordset rs
    rs.Close: con.Close: Columns.AutoFit
    Set con = Nothing: Set rs = Nothing
End Sub
 

Ekli dosyalar

hocam ellerinize sağlık, yaptığı işlem tam olarak istediğim sonucu vermiş.
sadece bunu buton olmadan yapabilirmiyiz? yani bana bu raporu veren bir sürü formüllerin sonuna bunu koysam diyorum, işin özü bu yaptığınız toplam çalışmasını kendi makrolar serimde otomatik bitirsem,butonu tıklamadan... mümkünmü? yada nasıl yaparım? tekrar tekrar saol..
 
Aşağıdaki kodu kullanırsanız butona gerek kalmaz...
A ve B sütunlarını doldurduktan sonra işlemi kendisi yapar.

Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim con As Object, rs As Object
    Set con = CreateObject("Adodb.connection")
    Set rs = CreateObject("Adodb.recordset")
    If Target.Column = 2 Then
    Range("C2:D1000").ClearContents
    con.Open "provider=microsoft.jet.oledb.4.0;data source=" & _
    ThisWorkbook.FullName & ";extended properties=""Excel 8.0;hdr=yes"""
    sorgu = "Select distinct Rakamlar, sum(Değer) from [Sayfa1$] group by Rakamlar "
    rs.Open sorgu, con, 1, 1
    Range("C65536").End(3)(2, 1).CopyFromRecordset rs
    rs.Close: con.Close: Columns.AutoFit
    End If: Set con = Nothing: Set rs = Nothing
End Sub
 
HOCAM, YAPAMADIM,FORMÜLÜ VERDİĞİNİZ ŞEKİLDE MAKRO DİZİNİMİNDE OLMASINI İSTEDİĞİM NOKTAYA YAPIŞTIRIYORUM, ANCAK HATA VERİYOR...(If Target.Column = 2 Then) ÖRNEK DOSYA YAPMA ŞANSIN OLURMU, FORMÜLE DOĞRU ŞEKİLDE YERLEŞTİREMEDİM SANIRIM... EN AZINDAN SİZİN DOSYADAN ÖRNEK ALIRIM... SİZİ YORDUM BİLİYORUM AMA...
 
Lütfen mesajınızı BÜYÜK HARFLER ile yazmayınız...

Örnek dosyayı ekliyorum...

İyi günler.
 

Ekli dosyalar

şimdi olayı netleştirdim hocam, çok güzel işliyor.. ellerine sağlık, uyarını dikkate alacağım, kusura bakma, iyi çalışmalar.
 
Yanlış anlamayın lütfen ! Daha başka uyarılarım da olacaktı ama burası yeri değil...

Rica ederim, sorunun çözüme kavuşmasına sevindim.
Size de iyi çalışmalar... :)
 
Biri yardımcı olabilirmi?.
Bende de 6000 ne yakın satır var.
Bu satırlarda aynı ismi olanlar bir defa yazılıp yanına aldıkları ürünlerin adetleri yazılsın.burada yeniyim.ek yüklemeyi bile bilemedim.yardımcı olacak olanlara şimdiden tşk ediyorum.
 
Mesaj yazdığınız yerin altında Dosya ekle/sil butonu var ona basın, açılan formda Gözat'tan dosyanızı seçin ve Upload butonuna basın. Hemen yüklenecektir ... Ardından formu kapatın ve mesajınızı gönderin...

Örnek dosya olmadan sunulan çözümlerde hep bir eksiklik, yanlışlık, yanlış anlatma ve yanlış anlaşılma olmakta...
Lütfen örnek dosyanızı görelim ve o dosya üzerinden çözüm üretelim...
 
Dosyayı ekleyemediniz mi ?
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst