• DİKKAT

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

Kullanılan adet kadar bul eksilt

A

ADER_34

Katılım
2 Haziran 2015
Mesajlar
349
Excel Vers. ve Dili
2010
Merhaba hayırlı akşamlar arkadaşlar bi konuda takıldım yardımcı olurmusunuz örnek dosyamda kullanılan parça listesini sayfa8 "A" sütununda part numarasına bak sayfa1 de bul sayfa8 de girilen sayı kadar eksilt şeklinde,sonra da sayfa 2 ye sayfa 8 deki part numrasını ve adeti yaz şeklide bir makroyaa ihitiyacım var örnek dosyam ekte kolay gelsin teşekkürler..
http://s6.dosya.tc/server6/j3z6ki/PARCA_LISTESI.rar.html
 
Çok teşekkür ederim sayın vardar7 istediğime yakın olmuş fakat Set s3 = Sheets("RE1CB") sayfasına
sadece kullanılan parça listesinde ki , part numarası ve adet yazmalı yani sayfa1den eksilen adet saya2 ye yazılmalı
 
Modül deki kodları aşağıdaki ile değiştirip deneyiniz.
Kod: 
Sub aktar()
Set s1 = Sheets(" KULLANILAN PARÇA LİSTESİ")
Set s2 = Sheets("RE1CG")
Set s3 = Sheets("RE1CB")
Set s4 = Sheets("RE1FG")
Set s5 = Sheets("RE1FS")
son = s1.Range("A65536").End(3).Row
For k = 1 To Sheets.Count
If Sheets(k).Name = s2.Name Or Sheets(k).Name = s4.Name Then
Set sy = Sheets(k)
a = sy.Name
If Sheets(k).Name = s2.Name Then Set syz = Sheets("RE1CB")
If Sheets(k).Name = s4.Name Then Set syz = Sheets("RE1FS")
For i = 2 To son
b = WorksheetFunction.CountIf(syz.Range("B6:B65536"), s1.Cells(i, "A"))
If b > 0 Then
Set bull = syz.Range("B6:B" & syz.Range("B65536").End(3).Row).Find(s1.Cells(i, "A"))
If Not bull Is Nothing Then
Set bul = syz.Range("B6:B" & syz.Range("B65536").End(3).Row).Find(s1.Cells(i, "A"))
If Not bul Is Nothing Then
sy.Cells(bul.Row, "I") = sy.Cells(bul.Row, "I") - s1.Cells(i, "b")
syz.Cells(bull.Row, "I") = syz.Cells(bull.Row, "I") + s1.Cells(i, "B")
s1.Range("A" & i & ":B" & i).Interior.Color = vbYellow
End If
End If
Else
Set bul = sy.Range("B6:B" & sy.Range("B65536").End(3).Row).Find(s1.Cells(i, "A"))
If Not bul Is Nothing Then
sy.Cells(bul.Row, "I") = sy.Cells(bul.Row, "I") - s1.Cells(i, "b")
son1 = syz.Range("B65536").End(3).Row + 1
syz.Cells(son1, "B") = s1.Cells(i, "A")
syz.Cells(son1, "C") = sy.Cells(bul.Row, "C")
syz.Cells(son1, "I") = s1.Cells(i, "B")
s1.Range("A" & i & ":B" & i).Interior.Color = vbYellow
End If
End If
Next i
End If
Next k
End Sub
 
Son düzenleme:
Teşekkürler sayın , vardar7 peki sayfa2 ye,sayfa1 deki "Description" ları yazdırmak istersem örnek
""11-004-240153""" SOCKET.DDR3..240P 4R 180D..G/F..1.5V.ORANGE(021C).AAA-DDR-099-K02....LEAD-FREE(RoHS).LOTEs""
ne yapmalıyım
 
#4 nolu mesajdaki kod isteğinize göre değiştirildi.
 
Sayın vardar7 aynı döngüyü aynı anda sayfa3 ve sayfa 4 de nasıl uygularız
 
#4 nolu mesajdaki kod isteğinize göre değiştirildi.
 
Merhaba vardar07 kodalrınızı denedim fakat durum şöyle özetle: sayfa8 de "kullanılan parça part no suna bak sayfa1 de bul ,
sayfa1 de azalt, sayfa2 yaz, eğer aynı part no kullanılrsa sayfa 1 de azalt sayfa 2 de çoğalt gibi yani aynı part no yu sayfa2 ye yazma ama adetini çoğat şeklinde tekrar örnek ekliyorum yardımcı olurmusunuz teşekkürler..

http://s8.dosya.tc/server2/qsl3p9/PARCA_LISTESI_2.rar.html
 
Son düzenleme:
Sayfa2 ye yazılan veriler sürekli orada kalacakmı yoksa 1 kullanımlıkmı?
 
Kodlarınız denedim ama hiçbir sonuç yok veriler tüm sayfalarda kalacak ,sadece her kullanılan adet üzerine yazılacak böyle devam edecek, sayfa1 den azalacak sayfa 2 de çoğalacak
 
Son düzenleme:
sayın varda07 veriler tüm sayfalarda silinmeden kalacak amacım kullandığım part no adetini sayfa1 de bul kullandığım adet kadar azalt, ve aynı part no yu sayfa2 de eğer yoksa ekle, eğer varsa bul ve kullanılan adeti üzerine ekle
 
#4 nolu mesajdaki kod isteğinize göre değiştirildi.
 
Sayın vardar07 kodlarınızı denedim çok güzel tam istediğim gibi sadece sayfa4 de çalışmıyor
sayfa3 de azaltıyor ama azalan miktarı sayfa4 de yazmıyor sayfa3 deki veriyi sayfa4 yazmazı gerekirken tüm veriyi sayfa2 ye aktarıyor
sayfa3 azalıyor sayfa 4 boş kalıyor sayfa 3 sonucu sayfa4 de olmalı
sayfa1 ve sayfa2 de olduğu gibi çünkü ürünler faklı
 
Son düzenleme:
İsteklerininizi baştan aşağı tekrar okuyunca son istediğiniz yok sadece Sayfa8 dekileri diğer sayfalarda bul Sayfa2 ye yaz şeklinde idi ona göre zaman harcadık. Sayfa3 tekileri Sayfa4 e yaz diye birşey yoktu. Boş bir vaktim olursa bakabilirim.Şimdilik benden bu kadar. Kolay gelsin.
 
Çok teşekkür ederim size boş vaktinizde bakarsanız sevinirim yada forumda ki müsait arakadaşlar bakarsa çünkü işlemin sonuna gelmiştik kolay gelsin.hayırlı geceler..
 
Selam arkadaşlar sayın vardar07 sağolsun yardımcı oldu kodlar istdeğim işlemi yapıyor fakat verileri
sadece , RE1CB sayfasına kopyalıyor ,"RE1CG" de olan "RE1CB" "ye "RE1FG" de olan ise "RE1FS" ye kopyalanmalı yardımcı olurmusunuz teşekkürler..
 
ADER_34' Alıntı:
Selam arkadaşlar sayın vardar07 sağolsun yardımcı oldu kodlar istdeğim işlemi yapıyor fakat verileri
sadece , RE1CB sayfasına kopyalıyor ,"RE1CG" de olan "RE1CB" "ye "RE1FG" de olan ise "RE1FS" ye kopyalanmalı yardımcı olurmusunuz teşekkürler..
Genişletmek için tıkla ...

"RE1CG" >>>> "RE1CB" ; "RE1FG" >>>> "RE1FS"

Bu sayfalar dışında eklenecek başka sayfa isteğiniz olacakmı.
 
Hayır sayın vardar07 sayfalar sabit eklenecek sayfam olmayacak
 
#4 nolu mesajdaki kod isteğinize göre değiştirildi.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst