+- AccessTr.neT (https://accesstr.net)
+-- Forum: Microsoft Excel (https://accesstr.net/forum-microsoft-excel.html)
+--- Forum: Excel Cevaplanmış Soruları (https://accesstr.net/forum-excel-cevaplanmis-sorulari.html)
+--- Konu Başlığı: Vlookup İle Hücre Grubunu Sonuç Olarak Döndürme (/konu-vlookup-ile-hucre-grubunu-sonuc-olarak-dondurme.html)
RE: Vlookup İle Hücre Grubunu Sonuç Olarak Döndürme - berduş - 06/05/2021
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ı
RE: Vlookup İle Hücre Grubunu Sonuç Olarak Döndürme - feraz - 06/05/2021
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.
RE: Vlookup İle Hücre Grubunu Sonuç Olarak Döndürme - feraz - 06/05/2021
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.
RE: Vlookup İle Hücre Grubunu Sonuç Olarak Döndürme - feraz - 06/05/2021
@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 SubRE: Vlookup İle Hücre Grubunu Sonuç Olarak Döndürme - berduş - 06/05/2021
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 SubRe: Vlookup İle Hücre Grubunu Sonuç Olarak Döndürme - berduş - 06/05/2021
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