Formülü makro olarak yazma

teonet

Altın Üye
Katılım
20 Kasım 2005
Mesajlar
401
Excel Vers. ve Dili
Ofis 2010 Türkçe
Altın Üyelik Bitiş Tarihi
09-05-2029
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

Altın Üye
Katılım
10 Şubat 2006
Mesajlar
644
Excel Vers. ve Dili
Office 2016
64 Bit
Altın Üyelik Bitiş Tarihi
21-12-2027
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
 
Son düzenleme:

teonet

Altın Üye
Katılım
20 Kasım 2005
Mesajlar
401
Excel Vers. ve Dili
Ofis 2010 Türkçe
Altın Üyelik Bitiş Tarihi
09-05-2029
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

Altın Üye
Katılım
10 Şubat 2006
Mesajlar
644
Excel Vers. ve Dili
Office 2016
64 Bit
Altın Üyelik Bitiş Tarihi
21-12-2027
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

Altın Üye
Katılım
20 Kasım 2005
Mesajlar
401
Excel Vers. ve Dili
Ofis 2010 Türkçe
Altın Üyelik Bitiş Tarihi
09-05-2029
Ç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

Altın Üye
Katılım
10 Şubat 2006
Mesajlar
644
Excel Vers. ve Dili
Office 2016
64 Bit
Altın Üyelik Bitiş Tarihi
21-12-2027
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

Altın Üye
Katılım
20 Kasım 2005
Mesajlar
401
Excel Vers. ve Dili
Ofis 2010 Türkçe
Altın Üyelik Bitiş Tarihi
09-05-2029
çok teşekkür ederim, kendime uyarlamaya çalışacağım. elinize emeğinize sağlık
 
Üst