ikili düşeyara

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,317
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Selamlar,

Aşağıdaki kodu deneyiniz.

Kod:
Option Explicit
 
Sub EŞLEŞENLERİ_AKTAR()
    Dim S1 As Worksheet, S2 As Worksheet, S3 As Worksheet, X As Long, BUL As Range
    
    Set S1 = Sheets("Sayfa1")
    Set S2 = Sheets("Sayfa2")
    Set S3 = Sheets("Sayfa3")
    
    S2.Range("A2:C65536").ClearContents
    
    For X = 2 To S1.Range("A65536").End(3).Row
        Set BUL = S1.Range("G:G").Find(S1.Cells(X, "B"), LookAt:=xlWhole)
        If Not BUL Is Nothing Then
            If S1.Cells(X, "D") = WorksheetFunction.Round(BUL.Offset(0, 2), 2) Then
                S1.Range("B" & X & ":D" & X).Copy S2.Range("A65536").End(3).Offset(1, 0)
                S1.Range("A" & X & ":D" & X).ClearContents
                S1.Range("F" & BUL.Row & ":I" & BUL.Row).ClearContents
            Else
                S1.Range("B" & X & ":D" & X).Copy S3.Range("A65536").End(3).Offset(1, 0)
                S1.Range("G" & BUL.Row & ":I" & BUL.Row).Copy S3.Range("E65536").End(3).Offset(1, 0)
                S1.Range("A" & X & ":D" & X).ClearContents
                S1.Range("F" & BUL.Row & ":I" & BUL.Row).ClearContents
            End If
        End If
    Next
    
    S1.Range("A2:D65536").Sort Key1:=Range("A2"), Order1:=xlAscending
    S1.Range("F2:I65536").Sort Key1:=Range("F2"), Order1:=xlAscending
        
    Set BUL = Nothing
    Set S1 = Nothing
    Set S2 = Nothing
    Set S3 = Nothing
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub
 
Katılım
5 Ağustos 2007
Mesajlar
35
Excel Vers. ve Dili
2003 & 2010 türkçe
Kusursuz olmuş çok teşekkür ederim iyi çalışmalar
 

by_ufuk

Altın Üye
Katılım
2 Ocak 2009
Mesajlar
96
Excel Vers. ve Dili
2003 Türkçe
Altın Üyelik Bitiş Tarihi
19-12-2027
Rica ederim sorun değil..

Formülde iki ayrı düşeyara olduğu için birinde hata var ise diğerini çalıştırdık. İşleyişi şu şekilde..

=EĞER(EHATALIYSA(1.DÜŞEYARA);2.DÜŞEYARA;1.DÜŞEYARA)

Anlamı ; eğer 1. düşeyara hatalıysa 2. düşeyara'yı çalıştır değil ise 1. düşeyarayı çalıştır..

.
Ömer bey,bu bahsettiğiniz 2'li Düşeyara işlemini 4'e yada daha fazlaya çıkarmak için ne yapmak lazım?
 

Ömer

Moderatör
Yönetici
Katılım
18 Ağustos 2007
Mesajlar
22,184
Excel Vers. ve Dili
Microsoft 365 Tr
Ofis 2016 Tr
Ömer bey,bu bahsettiğiniz 2'li Düşeyara işlemini 4'e yada daha fazlaya çıkarmak için ne yapmak lazım?
Merhaba,

Sorunuzu küçük bir örnek dosya ekleyerek detaylı açıklarsanız sorunuza uygun çözüm yolu tavsiyesinde bulunabiliriz.

.
 

by_ufuk

Altın Üye
Katılım
2 Ocak 2009
Mesajlar
96
Excel Vers. ve Dili
2003 Türkçe
Altın Üyelik Bitiş Tarihi
19-12-2027
Merhaba,

Sorunuzu küçük bir örnek dosya ekleyerek detaylı açıklarsanız sorunuza uygun çözüm yolu tavsiyesinde bulunabiliriz.

.
Dosyayı ekledim.
"1 - Firma" dosyasında bulunan A:C - F:H - K:M - P:R sütunlarında arama yapacak ve buradaki 3.değeri "Genel Liste" isimli dosyadaki K2 hücresine E2 hücresindeki koşula göre yazacak.
Bu örnekte 4 tane düşeyara kurulması gerekiyor ama şuan elimdeki bir diğer excel dosyasında yaklaşık 13 tane düşeyara lazım olacak.
 

Ekli dosyalar

Ömer

Moderatör
Yönetici
Katılım
18 Ağustos 2007
Mesajlar
22,184
Excel Vers. ve Dili
Microsoft 365 Tr
Ofis 2016 Tr
Bu örnekte 4 tane düşeyara kurulması gerekiyor ama şuan elimdeki bir diğer excel dosyasında yaklaşık 13 tane düşeyara lazım olacak.
Neden tablo yapınızı formüllere uygun olacek şekilde ayarlamıyorsunuz. 13 yada 50 sütunda çözüm bulunur fakat sütun sayısı artıkça formülü hızı da düşer.

Oysaki verileri yan yana değil alt alt hazırlasaydınız çok daha hızlı sonuçlar alırdınız.

Dizi formülüdür. Formül sonundaki +2, veriyi bulduğu sütunun iki yan sütunundaki değeri almak içindir. Siz hangi sütundan alacaksanız +2 değerini ona göre değiştirirsiniz.

Kod:
=İNDİS('[1 - Firma.xls]TyRpr'!$A$1:$S$50;MAK(('[1 - Firma.xls]TyRpr'!$A$3:
 $S$50=E2)*SATIR($A$3:$S$50));MAK(('[1 - Firma.xls]TyRpr'!$A$3:
  $S$50=E2)*SÜTUN($A$3:$S$50))[COLOR=red]+2[/COLOR])
.
 
Üst