• DİKKAT

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

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

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?
 
Ç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...
 
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
 
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

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...
 
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.
 
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.
 
Ben öyle yapsın diye ayarlamamış mıyım?
 
Daha açık yazar mısınız? Hangi şartta ne olması gerekirken, nasıl bir hata oluyor?
 
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
 
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.
 
Geri
Üst