AccessTr.neT

Tam Versiyon: Vlookup İle Hücre Grubunu Sonuç Olarak Döndürme
Şu anda arşiv modunu görüntülemektesiniz. Tam versiyonu görüntülemek için buraya tıklayınız.
Sayfalar: 1 2 3 4 5 6 7 8 9 10 11
(06/05/2021, 14:26)berduş yazdı: [ -> ]Sht2.Range("A148").RowHeight
Deneyemedim lakin 148 yerinede satır no buldurup ayarlanabilir bence Img-grin
    .Range("A" & SonStr).RowHeight = Sht2.Range("A" & RngBul.Row + (SonStr - 3)).RowHeight
ile değiştirilebilir
Berduş hocam konu sahibi biz gibi aldık başımızı gittik yine Img-grin
Benden paydos Img-grin
kodun son en son hali)
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
   
        .Range("C:Q").EntireColumn.Delete
        .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("A" & RngBul.Row + (SonStr - 3)).RowHeight
    x = SonStr
    y = CLng(Split(.UsedRange.Address, "$")(4))
    If y > x Then .Range("A" & SonStr + 1 & ":" & Split(.UsedRange.Address, ":")(1)).EntireRow.Delete
End With
    Application.FindFormat.Clear
    Application.CutCopyMode = False
   
End Sub

y = CLng(Split(Split(.UsedRange.Address, ":")(1), "$")(2)) bu kısmı biraz uzatmışım tek split de yeterliydi
y = CLng(Split(.UsedRange.Address, "$")(4))
Sayın Halil hocam 22.mesajdaki kod çalışmıyormuda o kadar dolambaçlı yollardan gittiniz?
dolambacın sebebi o değil hocam
[Resim: do.php?img=10992]
https://resim.accesstr.net/do.php?img=10992
bir de 22. mesajdaki kod 48 satır, 28. mesajdaki 45.  neredeyse aynı dolambaç da yok yani)
gereksiz boşluk ve kodlar silinince 41'e 37)
Sayfalar: 1 2 3 4 5 6 7 8 9 10 11