• DİKKAT

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

verileri koşullara göre aktarmak

E

eneskus

Katılım
22 Ocak 2010
Mesajlar
112
Excel Vers. ve Dili
2007 türkçe
öncelikle arkadaşlar aradım taradım ama bulamadım yada anlayamadım varsada özürdilerim kimse bana kızmasın

sayfa 1 de yazılan malzeme ismini ve adedi sayfa 2 de 3. satırda malzeme ismini arayacak ve bulduğu sutunun denginde aynı satır numarasına yazması ekte örnekle anlatmaya calıştım ama örnek küçük bir parça dosya satır ve sütun olarak 2000 e ulaşabilmekte

yardımlarınız için teşekkürler
 

Ekli dosyalar

eneskus' Alıntı:
öncelikle arkadaşlar aradım taradım ama bulamadım yada anlayamadım varsada özürdilerim kimse bana kızmasın

sayfa 1 de yazılan malzeme ismini ve adedi sayfa 2 de 3. satırda malzeme ismini arayacak ve bulduğu sutunun denginde aynı satır numarasına yazması ekte örnekle anlatmaya calıştım ama örnek küçük bir parça dosya satır ve sütun olarak 2000 e ulaşabilmekte

yardımlarınız için teşekkürler
Genişletmek için tıkla ...

Merhaba
D2 hücresine
Kod: 
=EĞER(YADA($A2="";C2="");"";İNDİS(Sayfa2!$C$5:$G$9;KAÇINCI($A2;Sayfa2!$A$5:$A$9;0);KAÇINCI(C2;Sayfa2!$C$3:$G$3;0)))
Bu formülü ve deneyin.
Aşağıya doğru çekerek çoğaltın. Sonra çoğaltığınız satır kadar kopyalayın ve diğer sütunlara yapıştırın.
 
arkadaşım yanlış anlatmışım sayfa1 e veri girilecek sayfa2 ye makro veya formmülle yazacak makrolu olursa sevinirim ilgilendiğin için teşekkürler
 
eneskus' Alıntı:
arkadaşım yanlış anlatmışım sayfa1 e veri girilecek sayfa2 ye makro veya formmülle yazacak makrolu olursa sevinirim ilgilendiğin için teşekkürler
Genişletmek için tıkla ...

Kırmızı ve mavi yerdeki çelişki nedir.
Formülü verdim daha ne olacak.
 
asi_kral_1967' Alıntı:
Kırmızı ve mavi yerdeki çelişki nedir.
Formülü verdim daha ne olacak.
Genişletmek için tıkla ...

formülle olduğunda kasma yapacak sayfa 1200 satır sütun 1000 yani 1200000 hüçre formülü olacak

şimdi makro ile olsa formülden daha az bilgisayarı yoracak ama makro ile mümkün olmazsa mecburen formülle olacak anlatmak istediğim bu yani arkadaşım ilgilendiğin için tekrardan teşekkürler
 
eneskus' Alıntı:
formülle olduğunda kasma yapacak sayfa 1200 satır sütun 1000 yani 1200000 hüçre formülü olacak

şimdi makro ile olsa formülden daha az bilgisayarı yoracak ama makro ile mümkün olmazsa mecburen formülle olacak anlatmak istediğim bu yani arkadaşım ilgilendiğin için tekrardan teşekkürler
Genişletmek için tıkla ...

Merhaba
Boş bir module kopyalayın ve deneyin.
Kod: 
Option Explicit
Sub veri_getir_1967()
'Konu       :   Malzeme Adına Göre Adet Bulma
'Mail       :   m.batu.1967@gmail.com
'Msn        :   m.batu.1967@hotmail.com.tr
'Skype      :   m.batu.1967
'Coder By   :   asi_kral_1967
Dim S1 As Worksheet, S2 As Worksheet
Dim SAT As Long, SÜT As Long
Set S1 = Sheets("Sayfa1")
Set S2 = Sheets("Sayfa2")
Application.ScreenUpdating = False
For SAT = 2 To S1.Cells(Rows.Count, "A").End(xlUp).Row
For SÜT = 3 To S1.Cells(1, Columns.Count).End(xlToLeft).Column
With WorksheetFunction
If S1.Cells(SAT, "A") <> Empty And S1.Cells(1, SÜT) = "malzeme adı" And _
S1.Cells(SAT, SÜT) <> Empty Then
S1.Cells(SAT, SÜT + 1) = .Index(S2.Range("C5:G" & Rows.Count), .Match(S1.Cells(SAT, "A"), _
S2.Range("A5:A" & Rows.Count), 0), .Match(S1.Cells(SAT, SÜT), S2.Range("C3:G3"), 0))
End If: End With: Next: Next
Application.ScreenUpdating = True
MsgBox "İşlem Tamamlandı" & vbLf & Application.UserName, _
vbInformation, "asi_kral_1967"
End Sub
 
asi_kral_1967' Alıntı:
Merhaba
Boş bir module kopyalayın ve deneyin.
Kod: 
Option Explicit
Sub veri_getir_1967()
'Konu       :   Malzeme Adına Göre Adet Bulma
'Mail       :   m.batu.1967@gmail.com
'Msn        :   m.batu.1967@hotmail.com.tr
'Skype      :   m.batu.1967
'Coder By   :   asi_kral_1967
Dim S1 As Worksheet, S2 As Worksheet
Dim SAT As Long, SÜT As Long
Set S1 = Sheets("Sayfa1")
Set S2 = Sheets("Sayfa2")
Application.ScreenUpdating = False
For SAT = 2 To S1.Cells(Rows.Count, "A").End(xlUp).Row
For SÜT = 3 To S1.Cells(1, Columns.Count).End(xlToLeft).Column
With WorksheetFunction
If S1.Cells(SAT, "A") <> Empty And S1.Cells(1, SÜT) = "malzeme adı" And _
S1.Cells(SAT, SÜT) <> Empty Then
S1.Cells(SAT, SÜT + 1) = .Index(S2.Range("C5:G" & Rows.Count), .Match(S1.Cells(SAT, "A"), _
S2.Range("A5:A" & Rows.Count), 0), .Match(S1.Cells(SAT, SÜT), S2.Range("C3:G3"), 0))
End If: End With: Next: Next
Application.ScreenUpdating = True
MsgBox "İşlem Tamamlandı" & vbLf & Application.UserName, _
vbInformation, "asi_kral_1967"
End Sub
Genişletmek için tıkla ...

işlem tamam diyor ancak aktarmıyor arkadaşım
 
asi_kral_1967' Alıntı:
Yanlış dosya eklediniz sanırım. Hiç veri yok ki Sayfa2'de hangi veriyi getirecek.
Genişletmek için tıkla ...

özür dilerim dosya doğru ancak sayıları yazmayı unutmuşum
yeni dosya ekliyorum oklar ve renklerle açıklamaya çalıştım ancak tekrardan belirtmek isterim sayfa 1 deki malzeme adının sağındaki adetleri sayfa 2 de aynı malzeme ve aynı sıra no nun kesişimine yazacak yani sayfa 1 den veri alınarak sayfa 2 ye yazılacak

ilgin için gercekten cok teşekkür etmeden gecemiyeceğim teşekkürler
 

Ekli dosyalar

eneskus' Alıntı:
özür dilerim dosya doğru ancak sayıları yazmayı unutmuşum
yeni dosya ekliyorum oklar ve renklerle açıklamaya çalıştım ancak tekrardan belirtmek isterim sayfa 1 deki malzeme adının sağındaki adetleri sayfa 2 de aynı malzeme ve aynı sıra no nun kesişimine yazacak yani sayfa 1 den veri alınarak sayfa 2 ye yazılacak

ilgin için gercekten cok teşekkür etmeden gecemiyeceğim teşekkürler
Genişletmek için tıkla ...

Bende sonuçları Sayfa2'den alıyor sayfa1'deki yerlerine gayet güzel getiriyor. Acaba yanlış bir işlem mi yapıyoruz anlamadım gitti. Adedi sütunundaki verileri silin ve kodu çalıştırıp deneyin sonuçları gözlemleyin.
 
Merhaba
Bunu dener misiniz_?
Kod: 
Option Explicit
Sub veri_getir_1967()
'Konu       :   Malzeme Adına Göre Adet Bulma
'Mail       :   m.batu.1967@gmail.com
'Msn        :   m.batu.1967@hotmail.com.tr
'Skype      :   m.batu.1967
'Coder By   :   asi_kral_1967
Dim S1 As Worksheet, S2 As Worksheet
Dim S1SAT As Long, S1SÜT As Long, _
S2SAT As Long, S2SÜT As Long
Set S1 = Sheets("Sayfa1")
Set S2 = Sheets("Sayfa2")
S2.Range("C5:G" & Rows.Count).ClearContents
Application.ScreenUpdating = False
For S2SAT = 5 To S2.Cells(Rows.Count, "A").End(xlUp).Row
For S2SÜT = 3 To S2.Cells(3, Columns.Count).End(xlToLeft).Column
For S1SAT = 2 To S1.Cells(Rows.Count, "A").End(xlUp).Row
For S1SÜT = 3 To S1.Cells(1, Columns.Count).End(xlToLeft).Column
If S1.Cells(1, S1SÜT) = "malzeme adı" Then
If S2.Cells(S2SAT, "A") = S1.Cells(S1SAT, "A") And _
S2.Cells(3, S2SÜT) = S1.Cells(S1SAT, S1SÜT) Then
S2.Cells(S2SAT, S2SÜT) = S1.Cells(S1SAT, S1SÜT + 1)
End If: End If: Next: Next: Next: Next
Application.ScreenUpdating = True
MsgBox "İşlem Tamamlandı" & vbLf & Application.UserName, _
vbInformation, "asi_kral_1967"
End Sub
 
asi_kral_1967' Alıntı:
Merhaba
Bunu dener misiniz_?
Kod: 
Option Explicit
Sub veri_getir_1967()
'Konu       :   Malzeme Adına Göre Adet Bulma
'Mail       :   m.batu.1967@gmail.com
'Msn        :   m.batu.1967@hotmail.com.tr
'Skype      :   m.batu.1967
'Coder By   :   asi_kral_1967
Dim S1 As Worksheet, S2 As Worksheet
Dim S1SAT As Long, S1SÜT As Long, _
S2SAT As Long, S2SÜT As Long
Set S1 = Sheets("Sayfa1")
Set S2 = Sheets("Sayfa2")
S2.Range("C5:G" & Rows.Count).ClearContents
Application.ScreenUpdating = False
For S2SAT = 5 To S2.Cells(Rows.Count, "A").End(xlUp).Row
For S2SÜT = 3 To S2.Cells(3, Columns.Count).End(xlToLeft).Column
For S1SAT = 2 To S1.Cells(Rows.Count, "A").End(xlUp).Row
For S1SÜT = 3 To S1.Cells(1, Columns.Count).End(xlToLeft).Column
If S1.Cells(1, S1SÜT) = "malzeme adı" Then
If S2.Cells(S2SAT, "A") = S1.Cells(S1SAT, "A") And _
S2.Cells(3, S2SÜT) = S1.Cells(S1SAT, S1SÜT) Then
S2.Cells(S2SAT, S2SÜT) = S1.Cells(S1SAT, S1SÜT + 1)
End If: End If: Next: Next: Next: Next
Application.ScreenUpdating = True
MsgBox "İşlem Tamamlandı" & vbLf & Application.UserName, _
vbInformation, "asi_kral_1967"
End Sub
Genişletmek için tıkla ...

Arkadaşım kodları denedim ellerine sağlık cok güzel çalışıyor.

Ancak ben gercek dosyama bunu aktaramadım kızmazsan yardımcı olursan cok memnun olurum

gercek dosyayı neden göndermedin dersen göndermiştim ama kimse anlamadı bende sildirdim daha basit olanı gönderdim

2 dosya ekliyorum örnek dosya sizin kodları eklediğim ve çalıştıramadığım dosya açıklama dosyası ise yapmak istediklerimi anlatan dosya,

tekrardan teşekkür ederim
 

Ekli dosyalar

Yalnız dosya çok büyük buna yardımcı olamam bunu çözene kadar inanın başka kişilere yardımcı olurum.
Şöyle yardımcı olmaya çalışayım size Bu dosyayı küçültün öyle ekleyin bakalım.
 
asi_kral_1967' Alıntı:
Yalnız dosya çok büyük buna yardımcı olamam bunu çözene kadar inanın başka kişilere yardımcı olurum.
Şöyle yardımcı olmaya çalışayım size Bu dosyayı küçültün öyle ekleyin bakalım.
Genişletmek için tıkla ...

istediğiniz gibi veri sayfasınıda diğer sayfayıda satır ve sütun olarak küçülttüm

formülde nerelerin ne işe yardığını en azından benim dosyama uygulamak için anlatırsanız kendim düzenlemeye calışırım

tekrardan cok teşekkürler
 

Ekli dosyalar

eneskus' Alıntı:
istediğiniz gibi veri sayfasınıda diğer sayfayıda satır ve sütun olarak küçülttüm

formülde nerelerin ne işe yardığını en azından benim dosyama uygulamak için anlatırsanız kendim düzenlemeye calışırım

tekrardan cok teşekkürler
Genişletmek için tıkla ...

Buyurun bu dosyaya uygun kod bu
Kod: 
Sub veri_getir_1967()
'Konu       :   Malzeme Adına Göre Adet Bulma
'Mail       :   m.batu.1967@gmail.com
'Msn        :   m.batu.1967@hotmail.com.tr
'Skype      :   m.batu.1967
'Coder By   :   asi_kral_1967
Dim S1 As Worksheet, S2 As Worksheet
Dim S1SAT As Long, S1SÜT As Long, _
S2SAT As Long, S2SÜT As Long
Set S1 = Sheets("VERİ")
Set S2 = Sheets("YENİ MALZEME MUTABAKATI")
S2.Range("D37:N" & Rows.Count).ClearContents
Application.ScreenUpdating = False
For S2SAT = 37 To S2.Cells(Rows.Count, "A").End(xlUp).Row
For S2SÜT = 4 To S2.Cells(4, Columns.Count).End(xlToLeft).Column
For S1SAT = 2 To S1.Cells(Rows.Count, "A").End(xlUp).Row
For S1SÜT = 20 To S1.Cells(1, Columns.Count).End(xlToLeft).Column
If S1.Cells(1, S1SÜT) Like "*Malzemenin Cinsi*" Then
If S2.Cells(S2SAT, "A") = S1.Cells(S1SAT, "A") And _
S2.Cells(4, S2SÜT) = S1.Cells(S1SAT, S1SÜT) Then
S2.Cells(S2SAT, S2SÜT) = S1.Cells(S1SAT, S1SÜT + 1)
End If: End If: Next: Next: Next: Next
Application.ScreenUpdating = True
MsgBox "İşlem Tamamlandı" & vbLf & Application.UserName, _
vbInformation, "asi_kral_1967"
End Sub
 
asi_kral_1967' Alıntı:
Buyurun bu dosyaya uygun kod bu
Kod: 
Sub veri_getir_1967()
'Konu       :   Malzeme Adına Göre Adet Bulma
'Mail       :   m.batu.1967@gmail.com
'Msn        :   m.batu.1967@hotmail.com.tr
'Skype      :   m.batu.1967
'Coder By   :   asi_kral_1967
Dim S1 As Worksheet, S2 As Worksheet
Dim S1SAT As Long, S1SÜT As Long, _
S2SAT As Long, S2SÜT As Long
Set S1 = Sheets("VERİ")
Set S2 = Sheets("YENİ MALZEME MUTABAKATI")
S2.Range("D37:N" & Rows.Count).ClearContents
Application.ScreenUpdating = False
For S2SAT = 37 To S2.Cells(Rows.Count, "A").End(xlUp).Row
For S2SÜT = 4 To S2.Cells(4, Columns.Count).End(xlToLeft).Column
For S1SAT = 2 To S1.Cells(Rows.Count, "A").End(xlUp).Row
For S1SÜT = 20 To S1.Cells(1, Columns.Count).End(xlToLeft).Column
If S1.Cells(1, S1SÜT) Like "*Malzemenin Cinsi*" Then
If S2.Cells(S2SAT, "A") = S1.Cells(S1SAT, "A") And _
S2.Cells(4, S2SÜT) = S1.Cells(S1SAT, S1SÜT) Then
S2.Cells(S2SAT, S2SÜT) = S1.Cells(S1SAT, S1SÜT + 1)
End If: End If: Next: Next: Next: Next
Application.ScreenUpdating = True
MsgBox "İşlem Tamamlandı" & vbLf & Application.UserName, _
vbInformation, "asi_kral_1967"
End Sub
Genişletmek için tıkla ...

Ellerine sağlık mükemmelsin. çalıştı.
ancak utanarak hattim olmayarak sölemek isterim dosyanın bir numara büyüğünü denedim 2 dk da hesapladı gercek dosya da ise 25 dk bekledim bitmedi malesef

ne yapmamız gerekmekte acaba

haddim olmayarak bir öneride bulunmak isterim
örnegin biz 2. satıra veri girmekteyiz u2,w2,y2,aa2,ac2,ae2 den herhangi birine veri girildiğinde 0 satır ile ilgili makro çalışarak miktar yazılır yazılmaz miktarı aktarsın

3. satıra gecilip u3,w3,y3,aa3,ac3,ae3 e mikarlar girildiğinde makro sadece 3. satırda işlm yapsa

makro işlemleri bölmüş oluruz bölelikle sorunu hallederiz diye düşünmekteyim sizin fikriniz nedir.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst