• DİKKAT

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

makro ile düşey aramada yardım

M

makasci

Katılım
10 Haziran 2010
Mesajlar
31
Excel Vers. ve Dili
vb
Private Sub Worksheet_Change(ByVal Target As Range)
On Local Error GoTo cikis
Dim syf As Worksheet
Set syf = Worksheets("sayfa2")
Select Case Target.Column
Case Is = 1
Select Case Target.Value
Case Is <> Empty
Target.Offset(0, 1).Value = _
WorksheetFunction.VLookup(Target, syf.Range("a1:j" & syf.Range("a65536").End(3).Row), 2, 0)
Target.Offset(0, 2).Value = _
WorksheetFunction.VLookup(Target, syf.Range("a1:j" & syf.Range("a65536").End(3).Row), 3, 0)
Target.Offset(0, 3).Value = _
WorksheetFunction.VLookup(Target, syf.Range("a1:j" & syf.Range("a65536").End(3).Row), 4, 0)
Target.Offset(0, 4).Value = _
WorksheetFunction.VLookup(Target, syf.Range("a1:j" & syf.Range("a65536").End(3).Row), 5, 0)
Target.Offset(0, 5).Value = _
WorksheetFunction.VLookup(Target, syf.Range("a1:j" & syf.Range("a65536").End(3).Row), 6, 0)
Target.Offset(0, 6).Value = _
WorksheetFunction.VLookup(Target, syf.Range("a1:j" & syf.Range("a65536").End(3).Row), 7, 0)
Target.Offset(0, 7).Value = _
WorksheetFunction.VLookup(Target, syf.Range("a1:j" & syf.Range("a65536").End(3).Row), 8, 0)
Target.Offset(0, 8).Value = _
WorksheetFunction.VLookup(Target, syf.Range("a1:j" & syf.Range("a65536").End(3).Row), 9, 0)
Target.Offset(0, 9).Value = _
WorksheetFunction.VLookup(Target, syf.Range("a1:j" & syf.Range("a65536").End(3).Row), 10, 0)
Target.Offset(0, 10).Value = _
WorksheetFunction.VLookup(Target, syf.Range("a1:j" & syf.Range("a65536").End(3).Row), 11, 0)
Target.Offset(0, 11).Value = "mehmet"

Case Else
Target.Offset(0, 1).Value = ""
Target.Offset(0, 2).Value = ""
Target.Offset(0, 3).Value = ""
Target.Offset(0, 4).Value = ""
Target.Offset(0, 5).Value = ""
Target.Offset(0, 6).Value = ""
Target.Offset(0, 7).Value = ""
Target.Offset(0, 8).Value = ""
Target.Offset(0, 9).Value = ""
Target.Offset(0, 10).Value = ""
End Select
Case Else
cikis:
Exit Sub
End Select
Set syf = Nothing
End Sub
Genişletmek için tıkla ...

Yukardaki kod sayfa1 den a sütunundan aldığı veriyi sayfa 2 de bularak verileri sayfa 1 e çekiyor.
ben A sütununa girdiğim verinin ilk 4 karakterini sayfa2 de aratmak istersem ne yapmalıyım
 
Kod: 
VLookup(Target

yerine

Kod: 
VLookup(Left(Target, 4)
 
bende sorun olmadı.

Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)

On Local Error GoTo cikis
Dim syf As Worksheet
Set syf = Worksheets("Sayfa2")
 
Select Case Target.Column
    Case Is = 1
        Select Case Target.Value
            Case Is <> Empty
                Target.Offset(0, 1).Value = _
                    WorksheetFunction.VLookup(Left(Target, 4), syf.Range("A1:J" & syf.Range("a65536").End(3).Row), 2, 0)
                Target.Offset(0, 2).Value = _
                    WorksheetFunction.VLookup(Left(Target, 4), syf.Range("A1:J" & syf.Range("a65536").End(3).Row), 3, 0)
                Target.Offset(0, 3).Value = _
                    WorksheetFunction.VLookup(Left(Target, 4), syf.Range("A1:J" & syf.Range("a65536").End(3).Row), 4, 0)
                Target.Offset(0, 4).Value = _
                    WorksheetFunction.VLookup(Left(Target, 4), syf.Range("A1:J" & syf.Range("a65536").End(3).Row), 5, 0)
                Target.Offset(0, 5).Value = _
                    WorksheetFunction.VLookup(Left(Target, 4), syf.Range("A1:J" & syf.Range("a65536").End(3).Row), 6, 0)
                Target.Offset(0, 6).Value = _
                    WorksheetFunction.VLookup(Left(Target, 4), syf.Range("A1:J" & syf.Range("a65536").End(3).Row), 7, 0)
                Target.Offset(0, 7).Value = _
                    WorksheetFunction.VLookup(Left(Target, 4), syf.Range("A1:J" & syf.Range("a65536").End(3).Row), 8, 0)
                Target.Offset(0, 8).Value = _
                    WorksheetFunction.VLookup(Left(Target, 4), syf.Range("A1:J" & syf.Range("a65536").End(3).Row), 9, 0)
                Target.Offset(0, 9).Value = _
                    WorksheetFunction.VLookup(Left(Target, 4), syf.Range("A1:J" & syf.Range("a65536").End(3).Row), 10, 0)
                Target.Offset(0, 10).Value = _
                    WorksheetFunction.VLookup(Left(Target, 4), syf.Range("A1:J" & syf.Range("a65536").End(3).Row), 11, 0)
                Target.Offset(0, 11).Value = "mehmet"
            Case Else
                Target.Offset(0, 1).Value = ""
                Target.Offset(0, 2).Value = ""
                Target.Offset(0, 3).Value = ""
                Target.Offset(0, 4).Value = ""
                Target.Offset(0, 5).Value = ""
                Target.Offset(0, 6).Value = ""
                Target.Offset(0, 7).Value = ""
                Target.Offset(0, 8).Value = ""
                Target.Offset(0, 9).Value = ""
                Target.Offset(0, 10).Value = ""
        End Select
    Case Else
cikis:
    Exit Sub
End Select

Set syf = Nothing

End Sub
 
mancubus' Alıntı:
bende sorun olmadı.

Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)

On Local Error GoTo cikis
Dim syf As Worksheet
Set syf = Worksheets("Sayfa2")
 
Select Case Target.Column
    Case Is = 1
        Select Case Target.Value
            Case Is <> Empty
                Target.Offset(0, 1).Value = _
                    WorksheetFunction.VLookup(Left(Target, 4), syf.Range("A1:J" & syf.Range("a65536").End(3).Row), 2, 0)
                Target.Offset(0, 2).Value = _
                    WorksheetFunction.VLookup(Left(Target, 4), syf.Range("A1:J" & syf.Range("a65536").End(3).Row), 3, 0)
                Target.Offset(0, 3).Value = _
                    WorksheetFunction.VLookup(Left(Target, 4), syf.Range("A1:J" & syf.Range("a65536").End(3).Row), 4, 0)
                Target.Offset(0, 4).Value = _
                    WorksheetFunction.VLookup(Left(Target, 4), syf.Range("A1:J" & syf.Range("a65536").End(3).Row), 5, 0)
                Target.Offset(0, 5).Value = _
                    WorksheetFunction.VLookup(Left(Target, 4), syf.Range("A1:J" & syf.Range("a65536").End(3).Row), 6, 0)
                Target.Offset(0, 6).Value = _
                    WorksheetFunction.VLookup(Left(Target, 4), syf.Range("A1:J" & syf.Range("a65536").End(3).Row), 7, 0)
                Target.Offset(0, 7).Value = _
                    WorksheetFunction.VLookup(Left(Target, 4), syf.Range("A1:J" & syf.Range("a65536").End(3).Row), 8, 0)
                Target.Offset(0, 8).Value = _
                    WorksheetFunction.VLookup(Left(Target, 4), syf.Range("A1:J" & syf.Range("a65536").End(3).Row), 9, 0)
                Target.Offset(0, 9).Value = _
                    WorksheetFunction.VLookup(Left(Target, 4), syf.Range("A1:J" & syf.Range("a65536").End(3).Row), 10, 0)
                Target.Offset(0, 10).Value = _
                    WorksheetFunction.VLookup(Left(Target, 4), syf.Range("A1:J" & syf.Range("a65536").End(3).Row), 11, 0)
                Target.Offset(0, 11).Value = "mehmet"
            Case Else
                Target.Offset(0, 1).Value = ""
                Target.Offset(0, 2).Value = ""
                Target.Offset(0, 3).Value = ""
                Target.Offset(0, 4).Value = ""
                Target.Offset(0, 5).Value = ""
                Target.Offset(0, 6).Value = ""
                Target.Offset(0, 7).Value = ""
                Target.Offset(0, 8).Value = ""
                Target.Offset(0, 9).Value = ""
                Target.Offset(0, 10).Value = ""
        End Select
    Case Else
cikis:
    Exit Sub
End Select

Set syf = Nothing

End Sub
Genişletmek için tıkla ...
hocam deneme ektedir 2003 te çalışmamaktadır. Yardımcı olursanız çok sevinirim
 

Ekli dosyalar

makasci' Alıntı:
hocam deneme ektedir 2003 te çalışmamaktadır. Yardımcı olursanız çok sevinirim
Genişletmek için tıkla ...

Merhaba
Kodu bununla değişir misiniz
Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
On Local Error GoTo cikis
Dim syf As Worksheet
Set syf = Worksheets("Sayfa2")
Select Case Target.Column
Case Is = 1
Select Case Target.Value
Case Is <> Empty
Target.Offset(0, 1).Value = _
WorksheetFunction.VLookup(Left(Target, 4) * 1, syf.Range("A1:J" & syf.Range("a65536").End(3).Row), 2, 0)
Target.Offset(0, 2).Value = _
WorksheetFunction.VLookup(Left(Target, 4) * 1, syf.Range("A1:J" & syf.Range("a65536").End(3).Row), 3, 0)
Target.Offset(0, 3).Value = _
WorksheetFunction.VLookup(Left(Target, 4) * 1, syf.Range("A1:J" & syf.Range("a65536").End(3).Row), 4, 0)
Target.Offset(0, 4).Value = _
WorksheetFunction.VLookup(Left(Target, 4) * 1, syf.Range("A1:J" & syf.Range("a65536").End(3).Row), 5, 0)
Target.Offset(0, 5).Value = _
WorksheetFunction.VLookup(Left(Target, 4) * 1, syf.Range("A1:J" & syf.Range("a65536").End(3).Row), 6, 0)
Target.Offset(0, 6).Value = _
WorksheetFunction.VLookup(Left(Target, 4) * 1, syf.Range("A1:J" & syf.Range("a65536").End(3).Row), 7, 0)
Target.Offset(0, 7).Value = _
WorksheetFunction.VLookup(Left(Target, 4) * 1, syf.Range("A1:J" & syf.Range("a65536").End(3).Row), 8, 0)
Target.Offset(0, 8).Value = _
WorksheetFunction.VLookup(Left(Target, 4) * 1, syf.Range("A1:J" & syf.Range("a65536").End(3).Row), 9, 0)
Target.Offset(0, 9).Value = _
WorksheetFunction.VLookup(Left(Target, 4) * 1, syf.Range("A1:J" & syf.Range("a65536").End(3).Row), 10, 0)
Target.Offset(0, 10).Value = _
WorksheetFunction.VLookup(Left(Target, 4) * 1, syf.Range("A1:J" & syf.Range("a65536").End(3).Row), 11, 0)
Target.Offset(0, 11).Value = "mehmet"
Case Else
Target.Offset(0, 1).Value = ""
Target.Offset(0, 2).Value = ""
Target.Offset(0, 3).Value = ""
Target.Offset(0, 4).Value = ""
Target.Offset(0, 5).Value = ""
Target.Offset(0, 6).Value = ""
Target.Offset(0, 7).Value = ""
Target.Offset(0, 8).Value = ""
Target.Offset(0, 9).Value = ""
Target.Offset(0, 10).Value = ""
End Select
Case Else
cikis:
Exit Sub
End Select
Set syf = Nothing
End Sub
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst