Veri eşleştirme

[ReaLFrienD]

sayın kardeşlerim;
benim sorunum 2 ayrı sayfalardaki ürün adları aynı fakat ürün numaları faklı formatt olan ürünleri birleştirmek.kısacası 1 adet sabit stok formatım var(ekteki dosyada 31 temmuz olarak geçiyo),1 adet'de programdan aldığım o günki stok tablosu var(ek'te sayfa1),stok tablosundaki ürünlerin miktarlarının stok formatındaki ürünlerin stok bölümüne işlenmesini istiyorum.bende bir makro çalışması var o şekilde aktaran.ama ürün numaralarını değiştirmiyo.yardımcı olursanız sevinirim.ayarlanacak çalışma ek'tedir.şu ankullandığımıda buraya yazayım

Sub aktar()

Set s1 = Sheets("11")
Set s2 = ActiveSheet

son = s2.[a65536].End(3).Row
dizi = s2.Range("a2:d" & son)
s1.Select
basla:
sut = Val(InputBox("Aktarılacak sütun numarasını girin " & vbCr & "K sütunu için : 11" & vbCr & "L sütunu için : 12 " & vbCr & "M sütunu için : 13" & vbCr & "N sütunu için : 14"))
If sut < 11 Or sut > 14 Then
If vbNo = MsgBox("Hatalı sütun numarası girdiniz. Tekrar Deneyin. İşlemden vazgeçmek için No ya basınız.", vbYesNo) Then Exit Sub
GoTo basla
End If

son2 = s1.[b65536].End(3).Row

For x = 10 To son2
If Cells(x, "B") <> "" Then
Cells(x, sut) = ""
For y = 1 To UBound(dizi)
If Cells(x, 2) <> "" And Cells(x, 2) = dizi(y, 1) Then
Cells(x, sut) = dizi(y, 4)
dizi(y, 2) = ""
Exit For
End If
Next y
End If
Next x

'Yazılmayanları işaretle
s2.Select

Range("a2:d" & son).Interior.Color = xlAutomatic

For y = 1 To UBound(dizi)
If dizi(y, 2) <> "" Then
Range("a" & y + 1 & ":d" & y + 1).Interior.Color = vbYellow
toplam = toplam + dizi(y, 4)
say = say + 1
End If
Next y
Erase dizi

If say = 0 Then
msg = "Tüm ürünler aktarıldı"
Else
msg = say & " çeşit ürün aktarılamadı." & vbCr & "Aktarılamayan ürün miktar toplamı:" & toplam
End If
MsgBox msg
End Sub

 

[Korhan Ayhan]

Selamlar,

&#304;nceledi&#287;im kadar&#305;yla ekledi&#287;iniz dosyadaki her iki sayfada e&#351;le&#351;en bir kriter g&#246;remedim. Bu veriler neye g&#246;re e&#351;le&#351;tirilicek a&#231;&#305;klarm&#305;s&#305;n&#305;z.

 

[ReaLFrienD]

cevap verdiğiniz için tşk.;
eşleşen veriler,örnek olarak: sayfa1 de mamul no sütunuda 0005103. kodlu ürün 31 TEMMUZ KLASÖRÜNDE 51-3 koduyla geçmektedir.yukarıdaki yazdığı makro eşleştirerek aktarım işlemini yapıyor ama 0005103. kodunu 51-3 e çevirmiyor.aşağıya şu an kullandığım makronun bir örneğini ekleyeyim.sanıreım anlatabildim.

 

[ReaLFrienD]

yok mu yard&#305;m eden acaba?

 

[Korhan Ayhan]

Selamlar,

Ekledi&#287;iniz iki dosyada farkl&#305; veriler var. A&#231;&#305;k&#231;as&#305; ne yapmak istedi&#287;iniz anlayamad&#305;m.

 

[ReaLFrienD]

B&#304;RAZ DAHA DE&#286;&#304;&#350;&#304;K &#350;EK&#304;LDE YAZAYIM
1. ad&#305;m) sayfa1'de yar alan 0005103. kodu temmuz klas&#246;r&#252;ndeki gibi 51-3 e &#231;evrilecek(bu &#252;r&#252;n bir tanesi, b&#252;t&#252;n &#252;r&#252;nlerin kodlar&#305; bu gibi &#231;evrilecek)
2.ad&#305;m) &#252;r&#252;n kodu 51-3'e &#231;evrildikten sonra SAYFA1 klas&#246;r&#252;ndeki 51-3 kodunun yan&#305;ndaki stok miktar&#305; ,TEMMUZ klas&#246;r&#252;ndeki 51-3 kodunun yan&#305;daki stok miktar&#305; k&#305;sm&#305;na gelecek.k&#305;saca hem stok kodu de&#287;i&#351;ecek hemde stok miktar&#305; di&#287;er tarafa aktar&#305;lacak.

 

[Korhan Ayhan]

Selamlar,

İlk eklediğiniz dosyadaki formata göre aşağıdaki kodu denermisiniz.

Sub AKTAR()
    Set S1 = Sheets(1)
    Set S2 = Sheets(2)
    S1.Select
    For X = 2 To S1.[B65536].End(3).Row
    If S1.Cells(X, 2) <> "" Then
    KOD = WorksheetFunction.Substitute(S1.Cells(X, 2), ".", "", 1) * 1
    S1.Cells(X, 2) = Left(KOD, Len(KOD) - 2) & "-" & Right(KOD, 1)
    End If: Next
    S2.Select
    For Y = 2 To [C65536].End(3).Row
    If WorksheetFunction.CountIf(S1.[B:B], Cells(Y, 3)) > 0 Then
    Cells(Y, 5) = WorksheetFunction.SumIf(S1.[B:B], Cells(Y, 3), S1.[A:A])
    Else
    Cells(Y, 5) = ""
    End If: Next
    Set S1 = Nothing
    Set S2 = Nothing
    MsgBox "İŞLEMİNİZ TAMAMLANMIŞTIR.", vbInformation
End Sub

 

[ReaLFrienD]

eme&#287;inize sa&#287;l&#305;k.&#351;u an oldu g&#246;r&#252;n&#252;yo bi kontrol edeyim.ALLAH RAZI OLSUN.