Soru Bir Hücredeki Değere Göre Veri Tabanında Satır Seçme

[officer08]

Herkese hayırlı günler.

Sayfa 1 A1 hücresinde Kayıt No olarak isimlendirdiğim sayısal bir değer var.

İstiyorum ki;

Sayfa 2 deki veri tabanı gibi kullandığım kısımda A2 den aşağıya doğru sıralanan Kayıt Nolar arasında uyuşanı bulsun ve bulduğu sayının yanında sıralanan satırda B, C, D, E, F, G, H sütunlarına denk gelen hücreleri seçsin

Mesela: Sayfa1 A1 hücresinde (3) yazılı olsun, Sayfa 2 de A4'de sayıyı bulsun yanında sıralanan B4, C4, D4, E4, F4, G4, H4 hücrelerini seçsin. Bunu formul şeklinde yardımcı olursanız sevinirim.

 

[officer08]

Kodu yazacakken formul yazmısım. Kodu lazım olacak

 

[Asri]

Aşağıdaki şekilde parametrik kullanabilirsiniz.
varmi da A olur ise sayfa2 de A kolonunda arar. B ise B kolonunda arar.
Kodu kendi projenize göre güncelleyiniz.

'Asri Akdeniz - www.asriakdeniz.com
Dim sh1, sh2
Dim bulsatir As Long

Sub verigetir()
    Set sh1 = Sheets("Sheet1")
    Set sh2 = Sheets("Sheet2")

   sonsatir = sh1.Cells(sh1.Rows.Count, "A").End(3).Row
   For j = 1 To sonsatir
       aranan = sh1.Cells(j, "A").Value
       bulsatir = varmi(aranan, "A")
       If bulsatir > 0 And aranan <> "" Then
          sh1.Cells(j, "B").Value = sh2.Cells(bulsatir, "B").Value
          sh1.Cells(j, "C").Value = sh2.Cells(bulsatir, "C").Value
          sh1.Cells(j, "D").Value = sh2.Cells(bulsatir, "D").Value
          sh1.Cells(j, "E").Value = sh2.Cells(bulsatir, "E").Value
          sh1.Cells(j, "F").Value = sh2.Cells(bulsatir, "F").Value
          sh1.Cells(j, "G").Value = sh2.Cells(bulsatir, "G").Value
          sh1.Cells(j, "H").Value = sh2.Cells(bulsatir, "H").Value
       End If
   Next j
  
End Sub

Function varmi(bilgi, secim) As Long
  
    If secim = "A" Then Set sayfak = sh2.Range("A:A").Find(bilgi, , xlValues, xlWhole)
    If secim = "B" Then Set sayfak = sh2.Range("B:B").Find(bilgi, , xlValues, xlWhole)
    If secim = "C" Then Set sayfak = sh2.Range("C:C").Find(bilgi, , xlValues, xlWhole)
    
    If Not sayfak Is Nothing Then
       varmi = sayfak.Row
       Exit Function
    End If
    varmi = 0
End Function

 

[Ömer]

Merhaba,

Yanlış anlamış olabilirim, istediğiniz bu mu? Şarta uyan satırların istenen aralığını seçer.

Sub Sec()

    Dim c As Range, Adr As String, S1 As Worksheet, S2 As Worksheet, cs As Range
  
    Set S1 = Sheets("Sayfa1")
    Set S2 = Sheets("Sayfa2")
    
    Application.ScreenUpdating = False
    
    Set c = S2.[A:A].Find(S1.[A1], , xlValues, xlWhole)
    If Not c Is Nothing Then
        S2.Select
        Adr = c.Address
        Do
            If cs Is Nothing Then
                Set cs = Cells(c.Row, "B").Resize(1, 7)
            Else
                Set cs = Application.Union(cs, Cells(c.Row, "B").Resize(1, 7))
            End If
            Set c = S2.[A:A].FindNext(c)
        Loop While Not c Is Nothing And c.Address <> Adr
    End If
    
    cs.Select
    
End Sub

 

[officer08]

İlgilendiğiniz için ikinize de çok teşekkür ederim arkadaşlar sayenizde başardım.