Formülü makro olarak yazma

[teonet]

Merhaba, Makro bilgim ve mantığım yok denilecek kadar az. Aşağıdaki formülü makro tarafına nasıl yazabiliriz. Yardımcı olabilir misiniz?

=ÇAPRAZARA($Q16&$R16;SCL!$D$2:$D$2000&SCL!$C$2:$C$2000;SCL!$H$2:$H$2000)

Şimdiden teşekkür ve saygılarımı sunarım

 

[muhasebeciyiz]

Sub CaprazaraFormulu()
Dim ws As Worksheet
Dim lookupValue As String
Dim lastRow As Long
Dim i As Long, j As Long
Dim matchFound As Boolean

Set ws = ThisWorkbook.Sheets("SCL")
lookupValue = ws.Range("Q16").Value & ws.Range("R16").Value
lastRow = ws.Cells(ws.Rows.Count, "D").End(xlUp).Row
matchFound = False
For i = 2 To lastRow
If (ws.Cells(i, "D").Value & ws.Cells(i, "C").Value) = lookupValue Then
ws.Range("A1").Value = ws.Cells(i, "H").Value
matchFound = True
Exit For
End If
Next i

If Not matchFound Then
ws.Range("A1").Value = "Eşleşme bulunamadı"
End If
End Sub

 

[teonet]

Değerli cevabın için teşekkürler.
Fakat çalıştıramadım, Run-time error '13': type mismatch hatası veriyor.

ayrı ayrı da denedim ama olmadı.

 

[muhasebeciyiz]

düzenkeme yapıldı denermisiniz

Bu kod, Q16 ve R16 hücrelerinin birleşimiyle elde edilen değeri, SCL sayfasındaki D ve C sütunlarının birleşimiyle elde edilen değerlerle karşılaştırır. Eşleşme bulunduğunda, H sütunundaki değeri A1 hücresine yazar. Eğer eşleşme bulunamazsa, A1 hücresine "Eşleşme bulunamadı" mesajını yazar.

 

[teonet]

Çok teşekkür ederim.
bu şekilde çalıştı. desteğin için teşekkürler. Aşağıdaki alanda, harflerde değişiklik yapmam gerekti.

lastRow = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row
matchFound = False
For i = 2 To lastRow
If (ws.Cells(i, "C").Value & ws.Cells(i, "D").Value) = lookupValue Then

Geliştirmek adına aşağıdaki konularda da yardımcı olabilir misin?
1- aktif sayfa yazmasını nasıl sağlayabilirim. SCL sayfası verilerin olduğu sayfa ama ben oraya değil örneğin Rapor isimli sayfaya yazdırmak istiyorum.
2-Gelen veri Q16 ve R16 bakarak ona A1 e sonucu yazıyor. Q16,Q17 ...... Q2000 aynı şekilde R16,R17 ...... Q2000 arayarak sonuçları A1,A2 ..... A2000 e yazdırabilir miyiz?
3- Şayet 2 dekini yapabilirsek Bu mantıkla buna ek olarak 2 tane daha bu şekilde ekleme yapabilir miyiz? H da yazanı alıyorduk buna ilave I,J daki veriler gibi.

Umarım anlatabildim. Yapılabilir bir şey ise örnek dosyada yükleyebilirim.

şimdiden tekrar çok teşekkür ederim.

 

[muhasebeciyiz]

Veriler "SCL" sayfasından alınıp sonuçları aktif sayfaya yazılsın istiyorsunuz. Kullanıcı hangi sayfada olursa olsun kod çalışacaktır.
Q16, Q17, ... Q2000 ve R16, R17, ... R2000 verilerinizi arayarak sonuçları A1, A2, ... A2000'e yazılacaktır
Verilen aralıktaki tüm hücreleri kontrol edip sonuçları belirttiğiniz hücrelere yazılacaktır.
"H" sütunundaki verinin yanında, "I" ve "J" sütunlarındaki verileri de yazdırılacaktır.

Sub CaprazaraFormulu()
Dim wsData As Worksheet
Dim wsActive As Worksheet
Dim lookupValue As String
Dim lastRow As Long
Dim lastLookupRow As Long
Dim i As Long, j As Long
Dim matchFound As Boolean
Dim result As Variant

Set wsData = ThisWorkbook.Sheets("SCL")

Set wsActive = ThisWorkbook.ActiveSheet

lastRow = wsData.Cells(wsData.Rows.Count, "C").End(xlUp).Row

lastLookupRow = wsActive.Cells(wsActive.Rows.Count, "Q").End(xlUp).Row

For i = 16 To lastLookupRow
lookupValue = wsActive.Range("Q" & i).Value & wsActive.Range("R" & i).Value
matchFound = False

For j = 2 To lastRow
If (wsData.Cells(j, "C").Value & wsData.Cells(j, "D").Value) = lookupValue Then
wsActive.Range("A" & (i - 15)).Value = wsData.Cells(j, "H").Value
wsActive.Range("B" & (i - 15)).Value = wsData.Cells(j, "I").Value
wsActive.Range("C" & (i - 15)).Value = wsData.Cells(j, "J").Value
matchFound = True
Exit For
End If
Next j

If Not matchFound Then
wsActive.Range("A" & (i - 15)).Value = "Eşleşme bulunamadı"
wsActive.Range("B" & (i - 15)).Value = ""
wsActive.Range("C" & (i - 15)).Value = ""
End If
Next i
End Sub

 

[teonet]

çok teşekkür ederim, kendime uyarlamaya çalışacağım. elinize emeğinize sağlık