• DİKKAT

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

Formulden makroya

  • Konbuyu başlatan Konbuyu başlatan ubay06
  • Başlangıç tarihi Başlangıç tarihi
Katılım
2 Ocak 2015
Mesajlar
47
Excel Vers. ve Dili
2010 ingilizce
Merhaba

Asagida yazdigim.formulu makro olacak sekilde nasil yapabiliriz record makro ozelligi disinda .

Teşekkürler

=IF(Sheet1!E:E>0;VLOOKUP(Sheet1!E:E;Sheet2!A:B;2;0);"1")
 
Merhaba,

Verileri E den arar F ye yazar.
Hem find ile (find daha hızlıdır), hemde düşeyara ile 2 farklı çözüm ekliyorum.

Kod:
Sub Ara_Yaz_Find()

    Dim S1 As Worksheet, S2 As Worksheet, i As Long, c As Range
    
    Set S1 = Sheets("Sayfa1")
    Set S2 = Sheets("Sayfa2")
    
    Application.ScreenUpdating = False
    S1.Range("F2:F" & Rows.Count).ClearContents
    
    For i = 2 To S1.Cells(Rows.Count, "E").End(xlUp).Row
        If S1.Cells(i, "E") > 0 Then
            Set c = S2.[A:A].Find(S1.Cells(i, "E"), , xlValues, xlWhole)
            If Not c Is Nothing Then
                S1.Cells(i, "F") = S2.Cells(c.Row, "B")
            End If
        Else
            S1.Cells(i, "F") = 1
        End If
    Next i
    
    Application.ScreenUpdating = False

End Sub

Sub Ara_Yaz_VLookup()

    Dim S1 As Worksheet, S2 As Worksheet, i As Long, c As Range, Wf As WorksheetFunction
    
    Set S1 = Sheets("Sayfa1")
    Set S2 = Sheets("Sayfa2")
    Set Wf = WorksheetFunction
    
    Application.ScreenUpdating = False
    S1.Range("F2:F" & Rows.Count).ClearContents
    
    For i = 2 To S1.Cells(Rows.Count, "E").End(xlUp).Row
        If S1.Cells(i, "E") > 0 Then
            If Wf.CountIf(S2.Range("A:B"), S1.Cells(i, "E")) > 0 Then
                S1.Cells(i, "F") = Wf.VLookup(S1.Cells(i, "E"), _
                    S2.Range("A:B"), 2, 0)
            End If
        Else
            S1.Cells(i, "F") = 1
        End If
    Next i
    
    Application.ScreenUpdating = False

End Sub

.
 
Ellerinize saglik cok.tesekkurler ...
 
Geri
Üst