• DİKKAT

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

İki ölçütlü karşılaştırıp veri alma

Katılım
3 Mayıs 2011
Mesajlar
3
Excel Vers. ve Dili
2007
Merhabalar arkadaşlar,

Benim formüllerle dolu bir exel tablolarım var.Aşağıdaki formülü tablonun birinde tüm hücrelere uygulamam gerekiyor ama exel çok kasıyor, hatta çalışmama izin vermiyor. Bu formülü makro yapma imkanımız varmıdır. Nasıl yaparız ve her hücre için ayrı makro mu yapmak gerekir.

=EĞERHATA(İNDİS(VERİ!$C:$C;TOPLA.ÇARPIM((KAÇINCI(AN$1&"@"&$A165;VERİ!$A:$A&"@"&VERİ!$B:$B;0))));0)

Formül bu yardımcı olabilirseniz beni çok büyük bir sorundan kurtarmış olacaksınız.

Teşekkürler.
 
hangi hücrelere yazılacak söylerseniz yardımcı olmaya çalışır.
böyle çözüm üretme şansımız bulunmuyor.
yada formül olan dosyanın küçük bir kısmını yükleyin oradan çözüm üretelim
 
ihsan hocamında dediği gibi dosya eklerseniz ne istediğiniz daha anlaşılır olur...

eğer verdiğiniz formulü bir kod ile hücreye yazdırmak istiyorsanız
bir makro kaydı açın ve bu formulün olması gerektiği hücreye

=EĞERHATA(İNDİS(VERİ!$C:$C;TOPLA.ÇARPIM((KAÇINCI(A N$1&"@"&$A165;VERİ!$A:$A&"@"&VERİ!$B:$B;0))));0)


bunu yapıştırın...
kayıdı durdurun..sonra kodlar bölümünde bu formülün kod halini görebilirsiniz....
 
Son düzenleme:
Tablo ekte ama sadece bu kadar değil baya bi kolon ve satır var.

bu kod'u denermisiniz
Kod:
Sub çok()
Dim i As Long
Dim h As Long
i = Cells(65536, "A").End(xlUp).Row
f = Cells(1, 256).End(xlToLeft).Column
For i = 5 To i
For f = 2 To f
Cells(i, f) = Evaluate("=IFERROR(INDEX(VERİ!C:C,SUMPRODUCT(MATCH(A" & i & "&B" & f & ",VERİ!B:B&VERİ!A:A,0)),1),0)")
Next f
Next i
End Sub
 
Bu makronunda formülden farkı yok ki, bu da kasıyor bilgisayarı. Daha doğrusu hazırladığım tabloyu.
 
Merhaba,

Module kopyalarak çalıştırınız.

Kod:
Sub Karsilastir()
 
Dim c As Range, Sv As Worksheet, ilkadres As Variant
Dim i As Long, j As Integer
 
Set Sv = Sheets("VERİ")
Sheets("mizan").Select
Range(Cells(5, 2), Cells(Rows.Count, Columns.Count)).ClearContents
 
For i = 5 To Cells(Rows.Count, "A").End(xlUp).Row
    With Sv.Range("B2:B" & Rows.Count)
        Set c = .Find(Cells(i, "A"), LookIn:=xlValues, LookAt:=xlWhole)
        If Not c Is Nothing Then
            ilkadres = c.Address
            Do
                For j = 2 To Cells(1, Columns.Count).End(xlToLeft).Column
                    If bHarf(Sv.Range("A" & c.Row)) = bHarf(Cells(1, j)) Then
                        Cells(i, j) = Sv.Range("C" & c.Row)
                    End If
                Next j
                Set c = .FindNext(c)
            Loop While Not c Is Nothing And c.Address <> ilkadres
        End If
    End With
Next i
End Sub
 
Function bHarf(Veri As String)
    bHarf = UCase(Replace(Replace(Veri, "i", "İ"), "ı", "I"))
End Function
Not: Soru başlıklarınızı genel ifade ile değil de konun içeriğini ifade edecek şekilde belirlemeye özen göstermenizi rica ederim.

.
 
Geri
Üst