• DİKKAT

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

ikili düşeyara

  • Konbuyu başlatan Konbuyu başlatan RALKAN
  • Başlangıç tarihi Başlangıç tarihi
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
 
Kusursuz olmuş çok teşekkür ederim iyi çalışmalar
 
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 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.

.
 
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

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])

.
 
Geri
Üst