Skip to main content

AccessTr.neT


Vlookup İle Hücre Grubunu Sonuç Olarak Döndürme

Vlookup İle Hücre Grubunu Sonuç Olarak Döndürme

#19
aklımdaydı ama unutmuşum eklemeyi; eğer girilen rakam son veriyse IVL bulunamayacağı için hata verecektir o nu da kontrol etmek gerek, bu durumda son satıra göre işlem yapılmalı
Cevapla
#20
Abey pc yi kapattığım için deneyemedim.
Ayrıca IVL syfasındaki son ver arnırsa yani arama sayfası b2 ye IVL sayfasının son stırındaki numara aratılırsa bence hata olur çünkü IVL Sayfa diye birşey hücrede olmayacağı için.
Biraz karışık anlattım ama deneyince yazarım nasipse.
Cevapla
#21
Berduş abey dediğimi denedim tahmin ettiğim gibi hata verdi.

IVL sayfasının 142 satırındaki veriyi(15.105.1106 ) aratırsanız bulmuyor halbuki var.
Onun için find ile tekrar bence şart eklenmeli.
Cevapla
#22
@berduş hocam dedikleri alttaki kod ile halletim sizin kodda az değişiklik yapıp.
Acele oldu iş dolayısıyla ama çalıştı.Deneyip olmayan kısımları tamamlayabilirsiniz isterseniz.

Sub FormatliAra(ByVal txtAranan As String)
Dim RngAra As Range
Dim RngSonuc As Range
Dim RngBul As Range
Dim RngBul2 As Range
Dim RngBul3 As Range
Dim RngBulSon As Range
Dim Cll As Range
Dim Sht As Worksheet
Dim Sht2 As Worksheet

Set Sht = ThisWorkbook.Worksheets("Arama")
Set Sht2 = ThisWorkbook.Worksheets("IVL")
Set RngAra = Sht2.Range("A:A")

    ' Clear previous formats and set new format
    Application.FindFormat.Clear
    Application.FindFormat.Font.Bold = True 'formatly arama için gerekli kod
With Sht
    Set RngBul = RngAra.Find(txtAranan, SearchFormat:=True)
    SonStr = .Cells(.Rows.Count, "c").End(xlUp).Row
    .Range("C2:x" & SonStr).ClearContents 'Arama Sayfasyny bo?altan kod
    If RngBul Is Nothing Then Exit Sub 'veri yoksa i?lemi iptal etme
   
    Set RngAra = Sht2.Range("A" & RngBul.Row & ":A" & RngBul.Row + 100)
    Set RngBulSon = Sht2.Range("A:A").Find("IVL No", , , , , xlPrevious, , SearchFormat:=True)
    Set RngBul3 = Sht2.Range("A:A").Find(txtAranan, SearchFormat:=True)
   
    Sht.Range("C2:XFD" & Rows.Count).Clear
       
    If RngBul3.Row - 1 = RngBulSon.Row Then
        SonStr = Sht2.Cells(.Rows.Count, "A").End(xlUp).Row
        Set RngSonuc = Sht2.Range("A" & RngBul.Row - 1 & ":L" & SonStr)
        RngSonuc.Copy Sht.Range("C2")
        GoTo var
    End If
   
    Set RngBul2 = RngAra.Find("IVL No", SearchFormat:=True)
    Set RngSonuc = Sht2.Range("A" & RngBul.Row - 1 & ":L" & RngBul2.Row - 1)
    RngSonuc.Copy Sht.Range("C2")
   
var:
    SonStr = .Cells(.Rows.Count, "c").End(xlUp).Row
    .Range("C" & SonStr & ":N" & SonStr).Merge
    .Range("C2:N" & SonStr).BorderAround Weight:=xlThin
End With
    Application.FindFormat.Clear
End Sub
.rar BulFormatlı_hy2.rar (Dosya Boyutu: 33,18 KB | İndirme Sayısı: 4)
Cevapla
#23
hocam kodu aşağıdaki gibi düzenleyince bir soruna rastlamadım
sadece son satırın yüksekliğini otomati ayarlayacak kod bulamadım henüz
Sub FormatliAra(ByVal txtAranan As String)
Dim RngAra As Range
Dim RngSonuc As Range
Dim RngBul As Range
Dim RngBul2 As Range
Dim Cll As Range
Dim Sht As Worksheet
Dim Sht2 As Worksheet

Set Sht = ThisWorkbook.Worksheets("Arama")
Set Sht2 = ThisWorkbook.Worksheets("IVL")
Set RngAra = Sht2.Range("A:A")

' Clear previous formats and set new format
Application.FindFormat.Clear
Application.FindFormat.Font.Bold = True 'formatly arama için gerekli kod
With Sht
Set RngBul = RngAra.Find(txtAranan, SearchFormat:=True)
SonStr = .Cells(.Rows.Count, "c").End(xlUp).Row
.Range("C2:x" & SonStr).ClearContents 'Arama Sayfasyny bo?altan kod
If RngBul Is Nothing Then Exit Sub 'veri yoksa i?lemi iptal etme

Set RngAra = Sht2.Range("A" & RngBul.Row & ":A" & RngBul.Row + 100)
Set RngBul2 = RngAra.Find("IVL No", SearchFormat:=True)

If RngBul2 Is Nothing Then rngRow = Sht2.Cells(Sht2.Rows.Count, "A").End(xlUp).Row Else rngRow = RngBul2.Row - 1

Set RngSonuc = Sht2.Range("A" & RngBul.Row - 1 & ":L" & rngRow)
Sht.Range("C2:XFD" & Rows.Count).Clear
RngSonuc.Copy
Sht.Range("C2").PasteSpecial xlPasteAllUsingSourceTheme

.Range("C2:N" & SonStr).BorderAround Weight:=xlThin
End With
Application.FindFormat.Clear
End Sub
Cevapla
#24
dosyanın son hali bu, dilerim işinize yarar
Sub FormatliAra(ByVal txtAranan As String)
Dim RngAra As Range
Dim RngSonuc As Range
Dim RngBul As Range
Dim RngBul2 As Range
Dim Cll As Range
Dim Sht As Worksheet
Dim Sht2 As Worksheet

Set Sht = ThisWorkbook.Worksheets("Arama")
Set Sht2 = ThisWorkbook.Worksheets("IVL")
Set RngAra = Sht2.Range("A:A")

    ' Clear previous formats and set new format
    Application.FindFormat.Clear
    Application.FindFormat.Font.Bold = True 'formatlı arama için gerekli kod
With Sht
    Set RngBul = RngAra.Find(txtAranan, SearchFormat:=True)
    SonStr = .Cells(.Rows.Count, "c").End(xlUp).Row
   
    For iCntr = 3 To 17
    .Columns(3).EntireColumn.Delete
    Next
        .Cells.RowHeight = 15

    If RngBul Is Nothing Then Exit Sub 'veri yoksa işlemi iptal etme
    Sh2SonStr = Sht2.Cells(Sht2.Rows.Count, "A").End(xlUp).Row
    Set RngAra = Sht2.Range("A" & RngBul.Row & ":A" & Sh2SonStr)
    Set RngBul2 = RngAra.Find("IVL No", SearchFormat:=True)
       
    If RngBul2 Is Nothing Then rngRow = Sh2SonStr Else rngRow = RngBul2.Row - 1
   
    Set RngSonuc = Sht2.Range("A" & RngBul.Row - 1 & ":O" & rngRow)
    RngSonuc.Copy
    .Range("C2").PasteSpecial xlPasteAll
    .Cells.EntireColumn.AutoFit
    SonStr = .Cells(.Rows.Count, "c").End(xlUp).Row
    .Range("A" & SonStr).RowHeight = Sht2.Range("A148").RowHeight
End With
    Application.FindFormat.Clear
    Application.CutCopyMode = False
   
End Sub
Cevapla

Bir hesap oluşturun veya yorum yapmak için giriş yapın

Yorum yapmak için üye olmanız gerekiyor

ya da
Task