Makro ile düşeyara yapmak.

[anilgsalkan]

Merhabalar,

ekteki dosyada Sayfa1 ve Sayfa 2 de değerler bulunmakta.

Sayfa2 deki değerleri düşeyara ile sayfa1 de b sütununda ki ilgili değerin karşısına getirmek istiyorum makro ile aşağıdaki kodu "commandbutton"a ekleyerek yazdım. ancak kod hata veriyor nerede yanlış yapmış olabilirim.
konuyla ilgili yardımlarınızı rica ediyorum.


Private Sub CommandButton1_Click()
Set s1 = Sayfa1("Sayfa1")
Set s2 = Sayfa2("Sayfa2")
son = s1.Cells(1048576, 2).End(xlUp).Row
son1 = s2.Cells(1048576, 2).End(xlUp).Row
alan = "a4:a" & son
For i = 1 To son
If s1.Cells(i, 1) = "" Then
s1.Cells(i, 1) = Application.WorksheetFunction.VLookup(s1.Cells(i, 1), s2.Range(alan), 2, 0)
End If
Next
End Sub

 

[asi_kral]

Merhaba

Private Sub CommandButton1_Click()
'Konu       :   Düşeyara Kod Düzenlemesi
'Mail       :   m.batu.1967@gmail.com
'Msn        :   m.batu.1967@hotmail.com
'Coder By   :   asi_kral_1967
'Not        :   Kod Düzenelemesi Yapılmıştır.
Dim s1, s2, son, son1, alan, i
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")
Application.ScreenUpdating = False
s1.Range("B:B").ClearContents
son = s1.Cells(Rows.Count, 1).End(xlUp).Row
son1 = s2.Cells(Rows.Count, 1).End(xlUp).Row
alan = "a4:B" & son1
For i = 1 To son
If WorksheetFunction.CountIf(s2.Range("A4:A" & son1), s1.Cells(i, 1)) > 0 Then
s1.Cells(i, 2) = Application.WorksheetFunction.VLookup(s1.Cells(i, 1), s2.Range(alan), 2, 0)
End If
Next
Application.ScreenUpdating = True
MsgBox "İşlem Tamamlandı", vbInformation, "asi_kral_1967"
End Sub

Bu kodu dener misiniz_?
Dosyanız Ekte.

 

[Korhan Ayhan]

Merhaba,

Alternatif olarak aşağıdaki kodu kullanabilirsiniz.

Düşeyara fonksiyonu aranan veriyi bulamadığı zaman hata verir. Kod bölümünde bu hatayı kontrol ederek sonuç üretebilirsiniz.

Private Sub CommandButton1_Click()
    Dim S1 As Worksheet, S2 As Worksheet, Veri As Variant
    
    Set S1 = Sheets("Sayfa1")
    Set S2 = Sheets("Sayfa2")
    
    On Error Resume Next
    
    For X = 1 To S1.Cells(Rows.Count, 1).End(xlUp).Row
        Err.Clear
        If S1.Cells(X, 1) <> "" Then
            Veri = Application.WorksheetFunction. _
            VLookup(S1.Cells(X, 1), S2.Range("A:B"), 2, 0)
                If Err.Number = 0 Then
                    S1.Cells(X, 2) = Veri
                Else
                    S1.Cells(X, 2) = ""
                End If
        End If
    Next
    
    Set S1 = Nothing
    Set S2 = Nothing
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[mhaluksen]

üstad eline sağlık, bizler için çok güzel şey. çok teşekkür ederim. Ama bir sorum olacak: Peki bu sütun ve satır sayısı 2 değilde daha fazla olursa Örneğin atıyorum 10 sütün 5000 satır olursa o zaman nasıl olacak? Şimdiden teşekkür ederim.

 

[Korhan Ayhan]

Merhaba,

Çok satırlı datalarda With-End With yöntemi ile formülü tüm hücrelere uygulayıp değere çevirebilirsiniz. Verilerinizin çokluğuna göre döngüye göre daha hızlı sonuç verebilir.

 

[mhaluksen]

Özür dilerim ama üstadım kodu yazabilir misiniz?

 

[Korhan Ayhan]

Merhaba,

Siz küçük bir örnek dosya ekleyerek gerekli açıklamaları yaparsanız kodu ona göre yazabiliriz.

 

[fatiherol06]

Merhaba

Düşeyara nın Yok hatasına nasıl bir formül ekleyebiliriz formül aşağıdaki gibidir


Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, Range("a16:A68")) Is Nothing Then Exit Sub
Range("E16:E68") = Application.VLookup(Range("A16:A68"), Sheets("Sayfa2").Range("A:T"), 7, False)
Range("B16:B68") = Application.VLookup(Range("A16:A68"), Sheets("Sayfa2").Range("A:T"), 2, False)
Range("D1668") = Application.VLookup(Range("A16:A68"), Sheets("Sayfa2").Range("A:T"), 9, False)
Range("G16:G68") = Application.VLookup(Range("A16:A68"), Sheets("Sayfa2").Range("A:T"), 8, False)
Range("E22") = Application.VLookup(Range("A22"), Sheets("Sayfa2").Range("A:H"), 7, False)

End Sub

 

[asi_kral]

Merhaba
Siz bu makronun çalıştığına emin misiniz ?

 

[engakb]

Değerli üstadlar merhaba, sitede vermiş olduğunuz bilgiler gerçekten çok yararlı. Son 1 yıldır takip ediyorum ve excel konusunda oldukça ilerledim. Öncelikle hepinize emekleriniz için teşekkür ederim.

Yukarıda yer alan vlookup macrosunu kullanıyorum fakat işlemin ne kadar sürdüğünü de görmek istiyorum. Görebileceğim bir yer var mı? Yada nasıl bir kod eklemeliyim?

İyi çalışmalar dilerim.