Excel Forum
ALTIN ÜYELİK Hakkında Bilgi


Geri Git   Excel Forum > EXCEL-Soruları > Makro-VBA
Atatürk
Şifremi Unuttum

DUYURU SİSTEMİ / REKLAM PANOSU

Makro-VBA Makro veya VBA ile ilgili sorularınızı buraya gönderebilirsiniz.
Dosya ekleyebilirsiniz

Özel Arama


Yanıtla
 
Paylaş Konu Araçları Görünüm Modları
Eski 16-05-2017, 22:31   #1
tahsinanarat
Altın Üye
 
Giriş: 14/03/2005
Şehir: İstanbul
Mesaj: 1,743
Excel Vers. ve Dili:
Ofis 2016 Türkçe
Varsayılan İki ayrı Cahenge kodunu birleştirme

Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
Dim hcr As Range, syf As Integer
If Intersect(Target, Range("c:c")) Is Nothing Then Exit Sub
If Target = "" Then Exit Sub

    Set hcr = Sheets("STOK").Cells.Find(Target, lookat:=xlWhole)
        If Not hcr Is Nothing Then
            Sheets("STOK").Select
            hcr.Select
        End If

Set hcr = Nothing
End Sub
Yukarıda verdiğim kod ile eklediğim örnek dosyanın satış sayfasının C sütununda bulunan model numaralarında herhangi birinde F2 enter yaptığında STOK sayfasında eşleşen ilk model numarasına gidiyor.
---------------------------------
Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim BUL As Range
    On Error GoTo Son
If Intersect(Target, Range("I2:I65536")) Is Nothing Then Exit Sub
    If Target = "" Then
    Else
        Set BUL = Sheets("database").Range("L:L").Find(Target)
        If Not BUL Is Nothing Then
        Target.Offset(0, -6).Value = BUL.Offset(0, -11).Value
        Target.Offset(0, -5).Value = BUL.Offset(0, -9).Value
        Target.Offset(0, -4).Value = BUL.Offset(0, -2).Value
        Target.Offset(0, -1).Value = Date
        'Target.Offset(0, 1).Value = BUL.Offset(0, 6).Value
     End If
    End If
For Sat = 2 To 65
If Cells(Sat, 9) = "" Then
'Rows(sat).Delete
Rows(Sat).ClearContents
End If
Next
Son:
End Sub
Bu kod eile, satış fişinen J sütununda yazılı bulunan barkodları database sayfasından model ve renk numaralarını getirmektedir.

Bu iki kod ayrı ayrı çalışmasında herhangi bir sıkıntı yok.
Benim istediğim her iki kodu birleştirerek Satış irsaliyesinde de C sütununda herhangi bir model numarısında F2 enter yaptığımda yine STOK Sayfasında ilk eşleşen Model numaraya gitmesi.
Her iki kodun birleştirmesini ne yaptımsa iki kodu bir arada çalıştıramadım, uzman arkadaşlardan yardım talep ediyorum.

Örnek dosyam etkedir.
Eklenmiş Dosyalar
Dosya Türü: xlsm stok_satış_takip.xlsm (731.2 KB, 5 Görüntülenme)
__________________
Kolay Gelsin Tahsin.
tahsinanarat Çevrimdışı   Alıntı Yaparak Cevapla
Eski 16-05-2017, 23:11   #2
Muhammet Okumuş
Destek Ekibi
 
Muhammet Okumuş kullanıcısının avatarı
 
Giriş: 28/09/2007
Şehir: Zonguldak
Mesaj: 3,419
Excel Vers. ve Dili:
2010 Türkçe
Varsayılan

Alıntı:
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
Dim hcr As Range, syf As Integer
If Intersect(Target, Range("c:c")) Is Nothing Then goto 10
If Target = "" Then Exit Sub

Set hcr = Sheets("STOK").Cells.Find(Target, lookat:=xlWhole)
If Not hcr Is Nothing Then
Sheets("STOK").Select
hcr.Select
End If

Set hcr = Nothing
10
Dim BUL As Range
On Error GoTo Son
If Intersect(Target, Range("I2:I65536")) Is Nothing Then Exit Sub
If Target = "" Then
Else
Set BUL = Sheets("database").Range("L:L").Find(Target)
If Not BUL Is Nothing Then
Target.Offset(0, -6).Value = BUL.Offset(0, -11).Value
Target.Offset(0, -5).Value = BUL.Offset(0, -9).Value
Target.Offset(0, -4).Value = BUL.Offset(0, -2).Value
Target.Offset(0, -1).Value = Date
'Target.Offset(0, 1).Value = BUL.Offset(0, 6).Value
End If
End If
For Sat = 2 To 65
If Cells(Sat, 9) = "" Then
'Rows(sat).Delete
Rows(Sat).ClearContents
End If
Next
Son:
End Sub
Bu şekil deneyiniz.
__________________
---------------------------------------------------
biliyorsan konuş ibret alsınlar,
bilmiyorsan sus adam sansınlar!
---------------------------------------------------
Muhammet Okumuş Çevrimiçi   Alıntı Yaparak Cevapla
Eski 16-05-2017, 23:19   #3
tahsinanarat
Altın Üye
 
Giriş: 14/03/2005
Şehir: İstanbul
Mesaj: 1,743
Excel Vers. ve Dili:
Ofis 2016 Türkçe
Varsayılan

Sn. Muhammed Okumuş, ilginiz için teşekkür ediyorum, ancak kod tam istediğim gibi çalışmıyor, şöyleki, j sütununda barkod numarasını yazdığım anda c sütunundaki model numarasına yanı stok sayfasını götürüyor, ben c sütununda F2 enter yaparsam götürmesi gerekiyor, umarım anlatabilmişimdir.
__________________
Kolay Gelsin Tahsin.
tahsinanarat Çevrimdışı   Alıntı Yaparak Cevapla
Eski 16-05-2017, 23:45   #4
Muhammet Okumuş
Destek Ekibi
 
Muhammet Okumuş kullanıcısının avatarı
 
Giriş: 28/09/2007
Şehir: Zonguldak
Mesaj: 3,419
Excel Vers. ve Dili:
2010 Türkçe
Varsayılan

Ben olayı yanlış anlamışım. F2 tuşuna ait kodu göremedim.
__________________
---------------------------------------------------
biliyorsan konuş ibret alsınlar,
bilmiyorsan sus adam sansınlar!
---------------------------------------------------
Muhammet Okumuş Çevrimiçi   Alıntı Yaparak Cevapla
Eski 16-05-2017, 23:52   #5
Muhammet Okumuş
Destek Ekibi
 
Muhammet Okumuş kullanıcısının avatarı
 
Giriş: 28/09/2007
Şehir: Zonguldak
Mesaj: 3,419
Excel Vers. ve Dili:
2010 Türkçe
Varsayılan

Alıntı:
Sub AUTO_OPEN()
Application.OnKey "{F2}", "XXX"
End Sub

Sub XXX()
Yapılmasını istediğiniz işlemlerin kodu
End Sub
Bu şekil yapabilirsiniz.
__________________
---------------------------------------------------
biliyorsan konuş ibret alsınlar,
bilmiyorsan sus adam sansınlar!
---------------------------------------------------
Muhammet Okumuş Çevrimiçi   Alıntı Yaparak Cevapla
Eski 17-05-2017, 00:02   #6
tahsinanarat
Altın Üye
 
Giriş: 14/03/2005
Şehir: İstanbul
Mesaj: 1,743
Excel Vers. ve Dili:
Ofis 2016 Türkçe
Varsayılan

Hocam, şöyle izah edeyim, sizin birleştirdiğiniz kodlar barkod okutulduğunda (yazıldıında) önce benim verdiğim ikinci kod sonra aynı anda verdiğim birinci kod çalışıyor. Benim istediğim tam tersi olacak önce ikinci verdiğim kod çalışacak, ben istersim c sütununda model noyu yazdığımda yada hücre içine girip enter dediğimde verdiğim birinci kod çalışacak, yani öncelik kod bilgilerinin getirilmesinde, sonra istenildiğimde birinci verdiğim kod devreye girecek şekilde birleştirebilirmiyiz.
__________________
Kolay Gelsin Tahsin.

Bu mesaj en son " 17-05-2017 " tarihinde saat 00:09 itibariyle tahsinanarat tarafından düzenlenmiştir....
tahsinanarat Çevrimdışı   Alıntı Yaparak Cevapla
Eski 17-05-2017, 00:15   #7
Muhammet Okumuş
Destek Ekibi
 
Muhammet Okumuş kullanıcısının avatarı
 
Giriş: 28/09/2007
Şehir: Zonguldak
Mesaj: 3,419
Excel Vers. ve Dili:
2010 Türkçe
Varsayılan

Yani siz 2. kod çalıştırdığımda işlemi yapsın ve satış sayfasına mı geçsin istiyorsunuz?
__________________
---------------------------------------------------
biliyorsan konuş ibret alsınlar,
bilmiyorsan sus adam sansınlar!
---------------------------------------------------
Muhammet Okumuş Çevrimiçi   Alıntı Yaparak Cevapla
Eski 17-05-2017, 00:18   #8
Muhammet Okumuş
Destek Ekibi
 
Muhammet Okumuş kullanıcısının avatarı
 
Giriş: 28/09/2007
Şehir: Zonguldak
Mesaj: 3,419
Excel Vers. ve Dili:
2010 Türkçe
Varsayılan

Valla hocam kusura bakmayın tam idrak edemedim. İsteklerinizi madde madde yazar mısınız?
__________________
---------------------------------------------------
biliyorsan konuş ibret alsınlar,
bilmiyorsan sus adam sansınlar!
---------------------------------------------------
Muhammet Okumuş Çevrimiçi   Alıntı Yaparak Cevapla
Eski 17-05-2017, 00:28   #9
tahsinanarat
Altın Üye
 
Giriş: 14/03/2005
Şehir: İstanbul
Mesaj: 1,743
Excel Vers. ve Dili:
Ofis 2016 Türkçe
Varsayılan

1-
Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim BUL As Range
    On Error GoTo Son
If Intersect(Target, Range("I2:I65536")) Is Nothing Then Exit Sub
    If Target = "" Then
    Else
        Set BUL = Sheets("database").Range("L:L").Find(Target)
        If Not BUL Is Nothing Then
        Target.Offset(0, -6).Value = BUL.Offset(0, -11).Value
        Target.Offset(0, -5).Value = BUL.Offset(0, -9).Value
        Target.Offset(0, -4).Value = BUL.Offset(0, -2).Value
        Target.Offset(0, -1).Value = Date
        'Target.Offset(0, 1).Value = BUL.Offset(0, 6).Value
     End If
    End If
For Sat = 2 To 65
If Cells(Sat, 9) = "" Then
'Rows(sat).Delete
Rows(Sat).ClearContents
End If
Next
Son:
End Sub
Hocam izah ediyorum:

önce bu kod çalışacak, j sütunundaki barkod bilgilerini çekecek. Bu kodun işi tamam,
2- Satış irsaliyesinde iken C sütununda yazılı bulunan model numarasına tıkladığımda (içine girip enterladığımda) stok sayfasında ilk eşleşen numaraya gidiyor,
Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
Dim hcr As Range, syf As Integer
If Intersect(Target, Range("c:c")) Is Nothing Then Exit Sub
If Target = "" Then Exit Sub

    Set hcr = Sheets("STOK").Cells.Find(Target, lookat:=xlWhole)
        If Not hcr Is Nothing Then
            Sheets("STOK").Select
            hcr.Select
        End If

Set hcr = Nothing
End Sub
Bu kodlar o işi yapıyor,
Birleştirmeyi bu şekilde yapmak istiyorum. Yani ben istemezsem STOK sayfasına gitmeyecek.
__________________
Kolay Gelsin Tahsin.
tahsinanarat Çevrimdışı   Alıntı Yaparak Cevapla
Eski 17-05-2017, 00:33   #10
Muhammet Okumuş
Destek Ekibi
 
Muhammet Okumuş kullanıcısının avatarı
 
Giriş: 28/09/2007
Şehir: Zonguldak
Mesaj: 3,419
Excel Vers. ve Dili:
2010 Türkçe
Varsayılan

Hocam o zaman bunu change olayına değil de kodları düğmeye atamak gerek. Düğmeye bastığınızda veya F2 tuşuna bastığınızda Stok sayfasına gider.
__________________
---------------------------------------------------
biliyorsan konuş ibret alsınlar,
bilmiyorsan sus adam sansınlar!
---------------------------------------------------
Muhammet Okumuş Çevrimiçi   Alıntı Yaparak Cevapla
Yanıtla


Konu Araçları
Görünüm Modları

Gönderme Kuralları
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is Açık
SimgelerAçık
[IMG] kodu Açık
HTML kodu Kapalı


Saat 16:42


Bu forum Elit NET - www.elitnet.com.tr tarafından sunulmaktadır.

Excel Eğitimi - Mobil Uygulama - Çorlu - Torna - Çorlu Web Tasarım - Tarot Falı - invest in turkey - Hurda - Lingerie - Dyeing Machine - Çorlu Temizlik- Karton Bardak- Çorlu Pimapenci- İstanbul Avukat- Çorlu Kekemelik- Edirne Su Arıtma- Çorlu Perde Yıkama- Site Yönetimi- Led Aydınlatma- Pronet Tekirdağ- Çorlu Kamera- Pronet Edirne- Pronet Kırklareli- Pronet Çerkezköy- Pronet Çorlu- Pronet Lüleburgaz- Pronet Keşan- Çorlu Araç Takip- Çorlu Su Arıtma- Çorlu İnşaat- Marmara Ereğlisi Yurt- Çorlu Solucan Gübresi- Boru Profil- Gebze Emlak- Beylikdüzü Temizlik- İstanbul Burun Estetiği- Su Deposu Temizliği- Bakır Sülfat- Rampa- Rotary-
Powered by vBulletin Version 3.7.2
Copyright ©2000 - 2017, Jelsoft Enterprises Ltd.
Advertisement System V2.6 By   Branden