2 ayrı işlemi bir anda yapma

[mücahitayan]

MERHABA ARKADAŞLAR, ÖNCELİKLE FORMU HAZIRLAYAN VE FORMA YAZAN DEĞERLİ UZMANLARIMIZA TEŞEKKÜR EDERİM.

İSTEĞİMİ KISACA YAZAYIM ZATEN DETAYLI AÇIKLAMASINI EKTEKİ DOSYADA YAPTIM.

- Üç adet sayfam var.
- 1. sayfada firma isimler kayıtlı
- 2. sayfamda firmaların fişleri kayıtlı (aynı firma adından bir kaç tane var)
- istediğim 1.sayfada firma isimlerine bir döngü yapacağız, döngü değerindeki firmayı 2. sayfada arayacağız. bulduğumuz değerlerin içinde tarihi en büyük olan fişi 3. sayfaya yazacağız.

böylelikle 1. sayfada yazılı olan tüm firmaların en büyük tarihli fişlerini 3. sayfaya tek bir işlemde aktarmış olacağım.


ilginiz için teşekkür ederim.

 

[mücahitayan]

Bu konu hakkında kimsenin bir fikri yok mu ?

 

[Necdet]

Merhaba,

Aşağıdaki kodları dener misiniz?

Sub Macro1()
Dim Sat As Long
Dim i   As Long
Dim sy  As Worksheet
Dim sk  As Worksheet
Dim ss  As Worksheet
Set sy = Sheets("YILLIK")
Set sk = Sheets("KAYIT")
Set ss = Sheets("SONUÇ")
Sat = sy.[A65536].End(3).Row
ss.Range("A2:B65000").ClearContents
Application.ScreenUpdating = False
For i = 2 To sk.[A65536].End(3).Row
    sk.Cells(i, "C").FormulaArray = "=MAX(IF(YILLIK!B2:B" & Sat & "=B" & i & ",YILLIK!A2:A" & Sat & "))"
Next i
sk.Columns("C:C").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    
sk.Range("B2:C" & i - 1).Copy ss.[A2]
sk.Columns("C:C").ClearContents
sk.[C2].Activate
Application.ScreenUpdating = True
MsgBox "İşlem Tamam.........."
End Sub

 

[mücahitayan]

Sayın necdet hocam bu işlerin acemisiyim kendi yaptığım programa uyduramadım bu konuda size o dosyayı ek olarak göndersem uydurabilir miyiz? Bu arada yapmış olduğunuz uzun süredir yapmak istediğim birşeydi teşekkür ederim.

 

[xp45s]

sn mücahitayhan zaten necdet hocam 3. göndermiş olduğu mesajında dosyayı düzelterek kodları eklemiş. 3. mesajdaki dosyayı indirip kullanabilirsiniz..

 

[Necdet]

Sayın necdet hocam bu işlerin acemisiyim kendi yaptığım programa uyduramadım bu konuda size o dosyayı ek olarak göndersem uydurabilir miyiz? Bu arada yapmış olduğunuz uzun süredir yapmak istediğim birşeydi teşekkür ederim.

Gönderdiğiniz dosya zaten yapmak istediğiniz işin örneği değil miydi?