• DİKKAT

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

düşey ara bul karşılık gelenleri tek hücreye yaz

K

komodor_82

Katılım
4 Ağustos 2009
Mesajlar
112
Excel Vers. ve Dili
Ofis 2010 TR 32 Bit
merhabalar.mevcut calışma dosyamda dosyamda takip edilen ürünler yer almakta.kod bölümüne düşey arama formülü ekleye bilimisiniz beceremedimmm ustadlar.acıklama ekli dosyada yeralıyor.iyi aksamlar...
 

Ekli dosyalar

komodor_82' Alıntı:
merhabalar.mevcut calışma dosyamda dosyamda takip edilen ürünler yer almakta.kod bölümüne düşey arama formülü ekleye bilimisiniz beceremedimmm ustadlar.acıklama ekli dosyada yeralıyor.iyi aksamlar...
Genişletmek için tıkla ...

Merhaba
Boş bir module kopyalayın ve deneyin.
Kod: 
Option Explicit
Sub bul_birleştir_1967()
'Konu       :   Bulunan Değerin Karşılıklarını Birleştir
'Mail       :   m.batu.1967@gmail.com
'Msn        :   m.batu.1967@hotmail.com.tr
'Coder By   :   asi_kral_1967
Dim asi As Long, kral As String, a
Range("B3:C3").ClearContents
For asi = 2 To Cells(Rows.Count, "E").End(xlUp).Row
If Cells(asi, "G") = Range("A3") Then
If Range("C3") = Empty Then
Range("B3") = Cells(asi, "F")
Else
Range("B3") = Range("B3") & vbLf & Cells(asi, "F")
End If
Range("C3") = Range("C3") + Cells(asi, "E")
End If: Next
MsgBox "İşlem Tamamlandı", vbInformation, "asi_kral_1967"
End Sub
Dosyanız Ekte
 

Ekli dosyalar

Teşekürler asi ustam. Fakat bunu makroyla değilde formülle yapamazmıyız.kod kısmına alt alta birden vok veri girildiğinde formülü kaydırarak işlemei gercekleştire bilirmiyiz....
 
birde ikinci sutundaki kodu aratınca verdiğiniz makra çalışmıyor..
 
komodor_82' Alıntı:
hatalı kısımları elirtmeye çalıştım ekli dosyada baka bilirseniz sevinirim bende bikaç formül ilavesi yaptım.
Genişletmek için tıkla ...

Bölüm kısmını formülle yapmaya kalktığımızda çok kasar dosyanızı bunun yerine kod yazarız kısa sürede istediğinizi yapar. Yok ben formülle istiyorum derseniz o zaman dilerseniz yeni konu açarak sorunuzu sorunuz.
 
kod olarak da ola bilir fakat tam olarak yetkin değilim makro kodlarına.sizin verdiğiniz koddaki g ve h sutunundaki değerleri bulup yazdıra bilecegim kod nedir acaba. ustad
 
komodor_82' Alıntı:
kod olarak da ola bilir fakat tam olarak yetkin değilim makro kodlarına.sizin verdiğiniz koddaki g ve h sutunundaki değerleri bulup yazdıra bilecegim kod nedir acaba. ustad
Genişletmek için tıkla ...

Boş bir module kopyalayın ve deneyin.
Kod: 
Option Explicit
Sub bul_birleştir_1967()
'Konu       :   Bulunan Değerin Karşılıklarını Birleştir
'Mail       :   m.batu.1967@gmail.com
'Msn        :   m.batu.1967@hotmail.com.tr
'Coder By   :   asi_kral_1967
Dim asi As Long, kral As String, a As Range
Dim b As Variant, c As Long
Range("B3:C" & Rows.Count).ClearContents
For asi = 3 To Cells(Rows.Count, "A").End(xlUp).Row
kral = Empty: c = 0
Set a = Range("H:H").Find(Cells(asi, "A"), , , xlWhole)
If Not a Is Nothing Then
b = a.Address
Do
If kral = Empty Then
kral = Cells(a.Row, "F")
Else
kral = kral & vbLf & Cells(a.Row, "F")
End If
c = c + Cells(a.Row, "E")
Set a = Range("H:H").FindNext(a)
Loop While Not a Is Nothing And a.Address <> b
End If
Cells(asi, "B") = kral
Cells(asi, "C") = c
Next
MsgBox "İşlem Tamamlandı", vbInformation, "asi_kral_1967"
End Sub
Dosyanız Ekte.
 

Ekli dosyalar

Son düzenleme:
sadece c kodlu ürünün aramasında doğru sonuç veriyor diğer kodlarda makro çalışmıyor yanılmıyorsam üstad.
 
komodor_82' Alıntı:
sadece c kodlu ürünün aramasında doğru sonuç veriyor diğer kodlarda makro çalışmıyor yanılmıyorsam üstad.
Genişletmek için tıkla ...

Üstteki mesajda ufak bir değişiklik yaptım. Ama sizin bahsettiğiniz gibi bir hata almadım.
Dilerseniz hata ne olması gerekiyorsa onu yazarak anlatın o şekilde bir düzenleme yapayım.
 
mesela e ve t kodlu ürünleri arattıgımızda sonuçu bulup getirmiyor ustad.
 
asi_kral_1967' Alıntı:
Boş bir module kopyalayın ve deneyin.
Kod: 
Option Explicit
Sub bul_birleştir_1967()
'Konu       :   Bulunan Değerin Karşılıklarını Birleştir
'Mail       :   m.batu.1967@gmail.com
'Msn        :   m.batu.1967@hotmail.com.tr
'Coder By   :   asi_kral_1967
Dim asi As Long, kral As String, a As Range
Dim b As Variant, c As Long
Range("B3:C" & Rows.Count).ClearContents
For asi = 3 To Cells(Rows.Count, "A").End(xlUp).Row
kral = Empty: c = 0
Set a = Range("H:H").Find(Cells(asi, "A"), , , xlWhole)
If Not a Is Nothing Then
b = a.Address
Do
If kral = Empty Then
kral = Cells(a.Row, "F")
Else
kral = kral & vbLf & Cells(a.Row, "F")
End If
c = c + Cells(a.Row, "E")
Set a = Range("H:H").FindNext(a)
Loop While Not a Is Nothing And a.Address <> b
End If
Cells(asi, "B") = kral
Cells(asi, "C") = c
Next
MsgBox "İşlem Tamamlandı", vbInformation, "asi_kral_1967"
End Sub
Dosyanız Ekte.
Genişletmek için tıkla ...

mesela bu gönderdiğiniz mesajdaki dosyada p kodlu ürün bulunmuyor
 
komodor_82' Alıntı:
örnegin bu dosyada p kodlu ürün bulunmamaktadır üsrad.
Genişletmek için tıkla ...

Merhaba
Kod: 
Option Explicit
Sub bul_birleştir_1967()
'Konu       :   Bulunan Değerin Karşılıklarını Birleştir
'Mail       :   m.batu.1967@gmail.com
'Msn        :   m.batu.1967@hotmail.com.tr
'Coder By   :   asi_kral_1967
Dim asi As Long, kral As String, a
Range("B3:C3").ClearContents
For asi = 2 To Cells(Rows.Count, "E").End(xlUp).Row
If Cells(asi, "H") = Range("A3") Then
If Range("C3") = Empty Then
Range("B3") = Cells(asi, "H")
Else
Range("B3") = Range("B3") & vbLf & Cells(asi, "F")
End If
Range("C3") = Range("C3") + Cells(asi, "E")
End If: Next
MsgBox "İşlem Tamamlandı", vbInformation, "asi_kral_1967"
End Sub
Bu kodu deneyin lütfen.
 
asi_kral_1967' Alıntı:
Merhaba
Kod: 
Option Explicit
Sub bul_birleştir_1967()
'Konu       :   Bulunan Değerin Karşılıklarını Birleştir
'Mail       :   m.batu.1967@gmail.com
'Msn        :   m.batu.1967@hotmail.com.tr
'Coder By   :   asi_kral_1967
Dim asi As Long, kral As String, a
Range("B3:C3").ClearContents
For asi = 2 To Cells(Rows.Count, "E").End(xlUp).Row
If Cells(asi, "H") = Range("A3") Then
If Range("C3") = Empty Then
Range("B3") = Cells(asi, "H")
Else
Range("B3") = Range("B3") & vbLf & Cells(asi, "F")
End If
Range("C3") = Range("C3") + Cells(asi, "E")
End If: Next
MsgBox "İşlem Tamamlandı", vbInformation, "asi_kral_1967"
End Sub
Bu kodu deneyin lütfen.
Genişletmek için tıkla ...

kodlar calışıyor ustad.fakat tam sonuç alamadık.a3 e yazılan kodu g ve h sutunda arayıp uygun olan karşılığı bölüm kodunu ve adet toplamı b3 e c3 e yazdırmayı tmm gerceleştiremedik
 
komodor_82' Alıntı:
kodlar calışıyor ustad.fakat tam sonuç alamadık.a3 e yazılan kodu g ve h sutunda arayıp uygun olan karşılığı bölüm kodunu ve adet toplamı b3 e c3 e yazdırmayı tmm gerceleştiremedik
Genişletmek için tıkla ...

Şimdi siz bana diyorsunuz ki ben 2 sütunda eşleşenleri listelesin istiyorum mu diyorsunuz.
Yalnız bu iş öyle olmaz bir seferde söylesenizde ilk seferde yazsaydık olmaz mıydı defalarca kod değiştirmek zorunda kalıyoruz. Bir diyorsunuz G sütunu yok olmadı H sütunu olsun şimdi diyorsunuz ikisi birden olsun.
 
asi_kral_1967' Alıntı:
Şimdi siz bana diyorsunuz ki ben 2 sütunda eşleşenleri listelesin istiyorum mu diyorsunuz.
Yalnız bu iş öyle olmaz bir seferde söylesenizde ilk seferde yazsaydık olmaz mıydı defalarca kod değiştirmek zorunda kalıyoruz. Bir diyorsunuz G sütunu yok olmadı H sütunu olsun şimdi diyorsunuz ikisi birden olsun.
Genişletmek için tıkla ...

aynen üstad en başında da her iki sutun da aratıp karşılıklarını getirmek istiyordum fakat tam anlaşılır olmadı sanırım.ilginize teşekürler güzel bir takip dosyası oluşturyp paylaşmak istediğimden yordum sizleride saolun..
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst