• DİKKAT

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

modüldeki kodu

tahsinanarat

Altın Üye
Katılım
14 Mart 2005
Mesajlar
2,181
Excel Vers. ve Dili
Ofis 2019 Türkçe
Kod:
Sub BulListele2()
    Set s1 = Sheets("Liste")
    Set S2 = Sheets("fiskontrolu")
    S2.Range("b2:h65536").ClearContents
    Son = s1.Cells(65536, 1).End(xlUp).Row
    son1 = S2.Cells(65536, 1).End(xlUp).Row
        For i = 2 To son1
        ara = S2.Cells(i, 1)
        Set c = s1.Range("G:G").Find(ara, , xlValues, xlPart)
            If Not c Is Nothing Then
              sat = c.Row
              S2.Cells(i, 2) = s1.Cells(sat, 1)
              S2.Cells(i, 3) = s1.Cells(sat, 2)
              S2.Cells(i, 4) = s1.Cells(sat, 3)
              S2.Cells(i, 5) = s1.Cells(sat, 4)
              S2.Cells(i, 6) = s1.Cells(sat, 5)
              S2.Cells(i, 7) = s1.Cells(sat, 6)
              S2.Cells(i, 8) = s1.Cells(sat, 7)
              End If
              Next
End Sub

yukarıdaki kodu makro ile çalıştırıp bir seferde karşılıklarını alabiliyorum,
bunu sayfanın kod bölümünde kullanmak istersen a sütununda aranan değiri yazdığım anda karşılığını getirmek istersem kodda nasıl bir değişiklik yapmalıyım. TÜeşekkürler.
 
Sorunuzu örnek dosya ile desteklerseniz çözüme çabuk ulaşırsınız.
 
Başka sayfadan tel no getirmek

Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Bul As Range
    On Error GoTo son

    If Intersect(Target, Range("h2:h65536")) Is Nothing Then Exit Sub
    If Target = "" Then
    Else
        Set Bul = Sheets("Teknisyen").Range("b:b").Find(Target)
        If Not Bul Is Nothing Then
        Target.Offset(0, -5).Value = Now
        Target.Offset(0, -6).Value = Bul.Offset(0, 1).Value & " " & Bul.Offset(0, 2).Value
        Target.Offset(0, -4).Value = Bul.Offset(0, -1).Value
        Target.Offset(0, -2).Value = Target.Offset(0, 0).Value
        'ActiveCell.Offset(-1, 3).Select 'Aktif hücrenin sağındakini seçer.
   End If
    End If
son:
End Sub

yukarıda sorduğum sorunun cevabını bir şekilde bu kodlarla çözmüş bulunuyorum.
Konu ile ilgili başka bir sorunum var; bu kodlarda H sütununa girdiğim fiş numarasını yazıp enterladığımda Teknisyen sayfasındaki bilgileri alabiliyorum, buraya kadar tamam. Ancak Teknisyen sayfasında bulunmayan Musteri_numaraları sayfasındaki F sütunundaki bu fişe ait telefon numarasını da aynı anda getirmek istiyorum.
 

Ekli dosyalar

Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Bul As Range
    On Error GoTo son

    If Intersect(Target, Range("h2:h65536")) Is Nothing Then Exit Sub
    If Target = "" Then
    Else
        Set Bul = Sheets("Teknisyen").Range("b:b").Find(Target)
        If Not Bul Is Nothing Then
        Target.Offset(0, -5).Value = Now
        Target.Offset(0, -6).Value = Bul.Offset(0, 1).Value & " " & Bul.Offset(0, 2).Value
        Target.Offset(0, -4).Value = Bul.Offset(0, -1).Value
        Target.Offset(0, -2).Value = Target.Offset(0, 0).Value
        'ActiveCell.Offset(-1, 3).Select 'Aktif hücrenin sağındakini seçer.
        else
              'İkinci sayfada bulma kodları
   End If
    End If
son:
End Sub
 
Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Bul As Range
    On Error GoTo son

    If Intersect(Target, Range("h2:h65536")) Is Nothing Then Exit Sub
    If Target = "" Then
    Else
        Set Bul = Sheets("Teknisyen").Range("b:b").Find(Target)
        If Not Bul Is Nothing Then
        Target.Offset(0, -5).Value = Now
        Target.Offset(0, -6).Value = Bul.Offset(0, 1).Value & " " & Bul.Offset(0, 2).Value
        Target.Offset(0, -4).Value = Bul.Offset(0, -1).Value
        Target.Offset(0, -2).Value = Target.Offset(0, 0).Value
        'ActiveCell.Offset(-1, 3).Select 'Aktif hücrenin sağındakini seçer.
        Else
            End If
    End If

    If Intersect(Target, Range("h2:h65536")) Is Nothing Then Exit Sub
    If Target = "" Then
    Else
        Set Bul2 = Sheets("musteri_telefonları").Range("a:a").Find(Target)
        If Not Bul2 Is Nothing Then
        Target.Offset(0, -7).Value = Bul2.Offset(0, 5).Value
   End If
    End If
son:
End Sub

Sn.askm yardımlarınız için çok teşekkür ederim, biraz uğraştım ama oldu:)
 
Rica ederim. Kolay gelsin.
 
Geri
Üst