Verilere göre sayfadan değer alma

[unutkan]

bu şekilde çalışıyor fakat veriler çoğaldıkça çok yavaş işlem yapıyor onun için vba da yazılabilirse düzelir sanıyorum.
yardımcı olursanız sevinirim.

 

[Ömer]

Merhaba,

Option Explicit
 
Sub VbaForm()
Dim i As Long, S1 As Worksheet
Application.ScreenUpdating = False
Set S1 = Sheets("VT")
Sheets("Sayfa1").Select
Range("B5:B65536").ClearContents
    For i = 5 To [A65536].End(3).Row
        If WorksheetFunction.CountIf(S1.Range("A:A"), Cells(i, "a")) <> 0 Then
            Cells(i, "b") = WorksheetFunction.VLookup(Cells(i, "a"), _
            S1.Range("A:B"), 2, 0)
        End If
    Next i
Set S1 = Nothing
Application.ScreenUpdating = True
End Sub

Bu şekilde deneyin.

.

 

[unutkan]

Merhaba,

Option Explicit
 
Sub VbaForm()
Dim i As Long, S1 As Worksheet
Application.ScreenUpdating = False
Set S1 = Sheets("VT")
Sheets("Sayfa1").Select
Range("B5:B65536").ClearContents
    For i = 5 To [A65536].End(3).Row
        If WorksheetFunction.CountIf(S1.Range("A:A"), Cells(i, "a")) <> 0 Then
            Cells(i, "b") = WorksheetFunction.VLookup(Cells(i, "a"), _
            S1.Range("A:B"), 2, 0)
        End If
    Next i
Set S1 = Nothing
Application.ScreenUpdating = True
End Sub

Bu şekilde deneyin.

.

bu şekilde çalışıyor fakat kod yazdığım zaman ismin yanına otomatik olarak gelmesi gerekiyor. butona tıklamadan oto. yapılabilir mi?

 

[Ömer]

Çalışma sayfasının kod bölümüne kopyalayın.

Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long, S1 As Worksheet
Set S1 = Sheets("VT")
Application.EnableEvents = False
If Intersect(Target, [A:B]) Is Nothing Then Exit Sub
If Target = "" Then Target.Offset(0, 1).ClearContents
    If WorksheetFunction.CountIf(S1.[A:A], Target) <> 0 Then
        Target.Offset(0, 1) = WorksheetFunction.VLookup(Target, S1.[A:B], 2, 0)
    Else
        Target.Offset(0, 1).ClearContents
    End If
Set S1 = Nothing
Application.EnableEvents = True
End Sub

.