Veri aktarma

Katılım
4 Mart 2010
Mesajlar
292
Excel Vers. ve Dili
2010 TÜRKÇE
Ilgili iki tablo arasında birinden diğerine
bilgi aktarmak istiyoruz . Tablo ektedir.
 

Ekli dosyalar

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,073
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
O kadar çok şey yazmışsınız ki "ne yapacağımı anlamadım" demekten utanıyorum :(

Açıklamanızda model, renk vs diye belirtmeniz kafa(mı) karıştırıyor. Sütun olarak belirtirseniz daha iyi olur. Şu sütundaki veriyi (ya da verinin şu kısmını) şu sütunda arayıp, karşısındaki şu sütun değerini bu sütuna getirsin şeklinde bir açıklama yapabilir misiniz?
 
Katılım
4 Mart 2010
Mesajlar
292
Excel Vers. ve Dili
2010 TÜRKÇE
Çok haklısın Kara Kartallı kardeşim.
o zaman çok basitçe yapmak istediğimi yazayım.
1-"raf bul" kısmına başka biryerden barkod yapıştıracağım
2-Bu barkodun ilk rakamı sıfır ise sıfırdan sonraki 7 haneyi alsın gerisini yazmasın.
3-Bu 7 haneli sayıyı "raf gir" sekmesinin MODEL sütununda arasın
4-Eger burada bulursa o satırı " raf bul " kısmına kopyalasın
5-Eğer MODEL sütununda birden fazla sayıda o rakamı bulursa onları da "raf bul"kısmına kopyalasın..

teşekkür ederim.Bana çok yardımcı oldunuz...
 

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,073
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Aşağıdaki kodu hazırladım ama nasıl sonuç verdiğini göremedim, çünkü kırmızı satırda hata veriyor.

Kod:
Run Time Error -2147417848 (80010108)

Method '_Default' of object 'Range' failed
Tecrübeli arkadaşlar bakarsa sevinirim:

Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
son = WorksheetFunction.Max(Cells(Rows.Count, "B").End(3).Row + 1, 3)
If Intersect(Target, Range("B3:B" & son)) Is Nothing Then Exit Sub
Set s2 = Sheets("RAF GİR")
raf = s2.Cells(Rows.Count, "E").End(3).Row
[COLOR="Red"]adet = WorksheetFunction.CountIf(s2.Range("E3:E" & raf), Left(Target * 1, 7))[/COLOR]
If adet = 1 Then
    For i = 3 To raf
        If Left(Target * 1, 7) = s2.Cells(i, "E") Then
            Target.Offset(0, 1) = s2.Cells(i, "D")
            Target.Offset(0, 2) = s2.Cells(i, "F")
            Target.Offset(0, 3) = Left(Target * 1, 7)
            Target.Offset(0, 5) = s2.Cells(i, "G")
        End If
        i = raf
    Next
Else
If adet > 1 Then
    yeni = Target.Row
    For i = 3 To raf
        If Left(Target * 1, 7) = s2.Cells(i, "E") Then
            Cells(yeni, "B") = Target
            Cells(yeni, "C") = s2.Cells(i, "D")
            Cells(yeni, "D") = s2.Cells(i, "F")
            Cells(yeni, "E") = Left(Target * 1, 7)
            Cells(yeni, "G") = s2.Cells(i, "G")
            yeni = yeni + 1
        End If
    Next
Else
MsgBox ("Girdiğiniz barkod, RAF GİR sayfasında bulunmamaktadır!")
End If
End If
End Sub
 

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,073
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Dosyanızda bazı değişiklikler yaptım ve kodumu da değiştirdim ancak hata vermeye devam ediyor. Üstadlar dosyadaki sorunun ne olduğuna bakarlarsa çok iyi olur.
 

Ekli dosyalar

ÖmerBey

Destek Ekibi
Destek Ekibi
Katılım
22 Ekim 2012
Mesajlar
4,340
Excel Vers. ve Dili
2007 Türkçe
Kod sayfada değişiklik yaptığı için defalarca change olayını çalıştırıyor. Bu da hafıza tüketiyor.
Kodunuzun başına ve sonuna aşağıdaki satırları ilave edip deneyiniz.
Başına:
Kod:
Set s2 = Sheets("RAF GİR")
[COLOR="Red"]Application.EnableEvents = False[/COLOR]
Sonuna:
Kod:
Application.EnableEvents = True
İyi çalışmalar...
 

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,073
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Kod sayfada değişiklik yaptığı için defalarca change olayını çalıştırıyor. Bu da hafıza tüketiyor.
Kodunuzun başına ve sonuna aşağıdaki satırları ilave edip deneyiniz.
Başına:
Kod:
Set s2 = Sheets("RAF GİR")
[COLOR="Red"]Application.EnableEvents = False[/COLOR]
Sonuna:
Kod:
Application.EnableEvents = True
İyi çalışmalar...
Hay Allah razı olsun. Gece saatler harcadım çözmek için, deli olacaktım nerdeyse.

Kodun son hali aşağıdadır:

Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("B3:B2000")) Is Nothing Then Exit Sub
Application.EnableEvents = False
Set s2 = Sheets("RAF GİR")
If WorksheetFunction.CountIf(s2.Range("E3:E2000"), Left(Target * 1, 7) * 1) = 1 Then
    For i = 3 To s2.Cells(Rows.Count, "E").End(3).Row
        If Left(Target * 1, 7) * 1 = s2.Cells(i, "E") Then
            Target.Offset(0, 1) = s2.Cells(i, "D")
            Target.Offset(0, 2) = s2.Cells(i, "F")
            Target.Offset(0, 3) = Left(Target * 1, 7) * 1
            Target.Offset(0, 5) = s2.Cells(i, "G")
            
            If Mid((Target * 1), 9, Len(Target) - 9) = "01" Or Mid((Target * 1), 9, Len(Target) - 9) = "02" Or Mid((Target * 1), 9, Len(Target) - 9) = "03" _
            Or Mid((Target * 1), 9, Len(Target) - 9) = "04" Or Mid((Target * 1), 9, Len(Target) - 9) = "05" Or Mid((Target * 1), 9, Len(Target) - 9) = "01" Then
                Target.Offset(0, 4) = WorksheetFunction.Index(["XS", "S", "M", "L", "XL", "XXL"], Mid((Target * 1), 9, Len(Target) - 9) * 1)
            Else
            Target.Offset(0, 4) = Mid((Target * 1), 9, Len(Target) - 9)
            End If
        End If
        i = s2.Cells(Rows.Count, "E").End(3).Row
    Next
Else
If WorksheetFunction.CountIf(s2.Range("E3:E2000"), Left(Target * 1, 7) * 1) > 1 Then
    yeni = Target.Row
    For i = 3 To s2.Cells(Rows.Count, "E").End(3).Row
        If Left(Target * 1, 7) * 1 = s2.Cells(i, "E") Then
            Cells(yeni, "B") = Target
            Cells(yeni, "C") = s2.Cells(i, "D")
            Cells(yeni, "D") = s2.Cells(i, "F")
            Cells(yeni, "E") = Left(Target * 1, 7) * 1
            Cells(yeni, "G") = s2.Cells(i, "G")
            
            If Mid(Cells(yeni, "B") * 1, 9, Len(Cells(yeni, "B") - 9)) = "01" Or Mid(Cells(yeni, "B") * 1, 9, Len(Cells(yeni, "B") - 9)) = "02" Or Mid(Cells(yeni, "B") * 1, 9, Len(Cells(yeni, "B") - 9)) = "03" _
            Or Mid(Cells(yeni, "B") * 1, 9, Len(Cells(yeni, "B") - 9)) = "04" Or Mid(Cells(yeni, "B") * 1, 9, Len(Cells(yeni, "B") - 9)) = "05" Or Mid(Cells(yeni, "B") * 1, 9, Len(Cells(yeni, "B") - 9)) = "01" Then
                Cells(Cells(yeni, "B"), "F") = WorksheetFunction.Index(["XS", "S", "M", "L", "XL", "XXL"], Mid(Cells(yeni, "B") * 1, 9, Len(Cells(yeni, "B") - 9)) * 1)
            Else
            Cells(yeni, "F") = Mid(Cells(yeni, "B") * 1, 9, Len(Cells(yeni, "B") - 9))
            End If

            yeni = yeni + 1
        End If
    Next
Else
MsgBox ("Girdiğiniz barkod, RAF GİR sayfasında bulunmamaktadır!")
End If
End If
Application.EnableEvents = True
End Sub

Yalnız düzgün çalışması için sizin asıl dosyanızda değil benim gönderdiğim halinde kullanmanızı tavsiye ederim. Çünkü sizin dosyanızdaki tablo biçimlendirmesinden dolayı makro sürekli hata veriyordu.
 
Katılım
4 Mart 2010
Mesajlar
292
Excel Vers. ve Dili
2010 TÜRKÇE
Yanlız modele göre arayıp bulsun istiyordum.
Bunun içim yapıştırdığım barkodun ilk 7 hanesine göre(ki bu 7 rakam modeli temsil eder) rafgir kısmında kaç tane o model varsa onları bulup sıramaladır.
Tabi yapıştırılan barkodun başında sıfır varsa onu dikkate almadan ondan sonraki 7 rakamı(model olarak ) dikkate almalıdır.
 

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,073
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Ben öyle yapsın diye ayarlamamış mıyım?
 

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,073
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Daha açık yazar mısınız? Hangi şartta ne olması gerekirken, nasıl bir hata oluyor?
 
Katılım
4 Mart 2010
Mesajlar
292
Excel Vers. ve Dili
2010 TÜRKÇE
Yani ben raf bul kısmına örn. 02300605703329 barkodunu girdiğimde

1- baştaki sıfırı göz ardı ederek raf gir kısmında 2300605 kısmını nerede
bulursa o satırı ( ki bu rakam birden fazla da olabilir) yada satırları
raf bul kısmında rengi,cinci ve rafını sıralasın
2- başta sıfır yoksa o zaman ilk baştan 7 haneyi raf kısmında arasın
 

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,073
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Gönderdiğim son dosya üzerinden gidersek, şöyle somutlaştırırsanız memnun olurum:

Bir barkod girin ve makronun bulduğu sonuçla, bulması gereken sonucu nedeniyle birlikte burada belirtin.
 
Üst