Skip to main content

AccessTr.neT


Vlookup İle Hücre Grubunu Sonuç Olarak Döndürme - Formatlı Ara - Tüm Sayfaya Uygulama

Vlookup İle Hücre Grubunu Sonuç Olarak Döndürme - Formatlı Ara - Tüm Sayfaya Uygulama

Çözüldü #1
Saygıdeğer Hocalarım

Mübarek Ramazan Bayramı akabinde Milli Bayramımızı kutlamak nasip oldu. Sizlerin nezdinde tüm AccessTr.net ailesi ve Türk Milletine bu kutlu günde sağlık, mutluluk ve esenlikler diliyor, başta Atamız Mustafa Kemal Atatürk olmak üzere bu günlerimize mihmandarlık etmiş tüm silah arkadaşları ve şehitlerimize şükranlarımı sunuyor, rahmet diliyorum.

@atoykan Hocamı da bir süredir göremiyorum kendileri iyidir inşallah. https://accesstr.net/konu-vlookup-ile-hu...tml?page=5 linkinde açmış olduğum sorumda Değerli @berduş hocamın paylaştığı dosya arama sayfasında tek bir hücre üzerinden aramada tam istediğim gibi çalışıyor. Bu örnekten yola çıkarak bütün bir sayfada uygulamaya çalıştığımda başarılı olamadım.

Yapmak istediğim bir sayfada listelenmiş IVL kodlarının analizlerinin aynı mantık ile aranarak sözkonusu sayfada listelemek:
IVL listesi tek satır olmasına karşılık analiz sonuçları çok sayıda satır ve sütundan oluşuyor. Buna göre ilk IVL analiz sonucu eklendiğinde takip eden 2. satırdaki IVL'den itibaren liste bu analiz sonucunun getirildiği satırın hemen altına taşınarak 2. IVL aranmalı ve sonucu getirilmeli,  sonra 3. satırdaki IVL'den itibaren liste bu 2. analiz sonucunun getirildiği satırın hemen altına taşınarak 3. IVL aranmalı.

@berduş Hocamın son çalışmasına küçük bir ekleme yaparak bu soruma örnek olarak ekliyorum. Eklediğim tum_sayfa adlı sayfada x kadar IVL alt alta girildiğinde ilk IVLden itibaren yukarıda bahsettiğim şekilde bu kodu çalıştırmayı ve sıralamayı nasıl yaptırabilirim?

Değerli yardımlarınız için şimdiden şükranlarımı sunuyorum.

Saygılarımla

Murtaza AF
.rar BulFormatlı_hy2.rar (Dosya Boyutu: 36,68 KB | İndirme Sayısı: 2)
Son Düzenleme: 19/05/2021, 16:36, Düzenleyen: MURTAZAAF. (Sebep: imla hataları)
Cevapla
#2
bahsettiğiniz sarı renkli 8 satır veri nereden geliyor, neye göre bu IVL'ler alınıyor?
bu IVL'ler de bold olanlardan mı alınıyor?

bahsetiiğiniz işlem otomatik olarak siz bir tuşa bastığınızda IVL sayfasındaki tüm Koyu IVL'lere mi uygulanayacak?
baştan aralardan ve sondan alacaığınız 3 örnek IVL için işlemin sonucunu içeren sayfayla beraber dosyanızı tekrar yükleyip açıklr mısınız?
Cevapla
#3
tekrar okuyunca ilk 2 maddeyi sanırım anladım, ama 3. ve 4. maddeler hala geçerli, siz bir düğmeye basınca işlem otomatik olarak mı gerçekleşecek?
Cevapla
#4
yapmaya çalıştığınız şeyi tam anlamadım galiba, sanki IVL sayfasındaki tüm verileri alıp Tum_Sayfa sayfasının D-R sütunlarına kopyalamak ve ilk koyu IVL değerlerinin olduğu satırdaki verilerini de A,B,C sütunlarına almak istiyorsunuz, doğru mu?
Cevapla
#5
dilerim işinize yarar
Visual Basic Code
Function FilterBoldNumeric() 'ByVal Rng As Range) '?FilterBoldNumeric(sayfa1.Range("A:A"))
    
    With ThisWorkbook.Sheets("Tum_Sayfa")
    LastRow = .Cells(.Rows.Count, "D").End(xlUp).Row + 10
        .Range("A2:O" & LastRow).UnMerge
        .Range("A2:O" & LastRow).Clear
        .Cells.UseStandardHeight = True
        .Cells.UseStandardWidth = True
    End With

    Dim Rng As Range
    Dim Hucr As Range
    Dim HucrSon As Range
    Dim BytRng As Range
    Dim HcrByt As Range
    
    Set Rng = Sayfa1.Range("A:A")
    SonStr = Rng.Rows(Rng.Rows.Count).End(xlUp).Row 'burada sadece ilk sütundaki veriye bakar
    Set Rng = Rng.Worksheet.Range("A2:" & Rng.Rows(Rng.Rows.Count).End(xlUp).Address(0, 0))
    
    Dim BasRng As Range
    Dim KynkRng As Range
    Dim HdfRng As Range
    Dim StrRw As Long
    Dim AbcStn As Range, iCells As Range

Set HdfRng = ThisWorkbook.Sheets("Tum_Sayfa").Range("D:D")

    For Each Hucr In Rng
    If BasRng Is Nothing Then
        Set BasRng = Hucr
        GoTo 10
    End If
        If Hucr.Font.Bold = True And IsNumeric(Hucr.Value) = True Then
        StrRw = IIf(Hucr.Row < 3, 1, Hucr.Row - 2)
            
            SonStrHdf = HdfRng.Rows(HdfRng.Rows.Count).End(xlUp).Row + 2
            SonStrHdf = IIf(SonStrHdf = 3, 2, SonStrHdf)
            
            Set UcStn = Rng.Worksheet.Range(BasRng.Address, Cells(BasRng.Row, "O").Address)
            UcStn.Borders.LineStyle = xlContinuous
            UcStn.Borders.Weight = xlThin
            
            HdfRng.Worksheet.Range("A" & SonStrHdf) = UcStn.Worksheet.Range("A" & UcStn.Row)
            HdfRng.Worksheet.Range("B" & SonStrHdf) = UcStn.Worksheet.Range("B" & UcStn.Row)
            HdfRng.Worksheet.Range("C" & SonStrHdf) = UcStn.Worksheet.Range("L" & UcStn.Row)
            
            Set IRange = HdfRng.Worksheet.Range("A" & SonStrHdf & ":" & "C" & SonStrHdf)

            For Each iCells In IRange
                iCells.BorderAround LineStyle:=xlContinuous, Weight:=xlThin
            Next iCells
            
            Set KynkRng = Rng.Worksheet.Range(BasRng.Address, Cells(StrRw, "O").Address)

            KynkRng.Copy
            HdfRng.Worksheet.Range("D" & SonStrHdf).PasteSpecial xlPasteAll
            
            Set KynkRng = KynkRng.Offset(, 11) 'L satırı için
            HdfRng.Rows(HdfRng.Rows.Count).End(xlUp).RowHeight = KynkRng.Rows(KynkRng.Rows.Count).End(xlUp).Offset(1, -11).RowHeight
            Set BasRng = Hucr

        End If
10
    Next Hucr
        
        StrRw = IIf(BasRng.Row < 3, 1, BasRng.Row - 2)
            
            Set KynkRng = Rng.Worksheet.Range(BasRng.Address, Cells(SonStr, "O").Address)
            SonStrHdf = HdfRng.Rows(HdfRng.Rows.Count).End(xlUp).Row + 2
            SonStrHdf = IIf(SonStrHdf = 3, 2, SonStrHdf)
            
            Set UcStn = Rng.Worksheet.Range(BasRng.Address, Cells(BasRng.Row, "O").Address)
            HdfRng.Worksheet.Range("A" & SonStrHdf) = UcStn.Worksheet.Range("A" & UcStn.Row)
            HdfRng.Worksheet.Range("B" & SonStrHdf) = UcStn.Worksheet.Range("B" & UcStn.Row)
            HdfRng.Worksheet.Range("C" & SonStrHdf) = UcStn.Worksheet.Range("L" & UcStn.Row)
            Set IRange = HdfRng.Worksheet.Range("A" & SonStrHdf & ":" & "C" & SonStrHdf)

            For Each iCells In IRange
                iCells.BorderAround LineStyle:=xlContinuous, Weight:=xlThin
            Next iCells
            
            KynkRng.Copy
            HdfRng.Worksheet.Range("D" & SonStrHdf).PasteSpecial xlPasteAll

            
            Set KynkRng = KynkRng.Offset(, 11) 'L satırı için
            HdfRng.Rows(HdfRng.Rows.Count).End(xlUp).RowHeight = KynkRng.Rows(KynkRng.Rows.Count).End(xlUp).Offset(1, -11).RowHeight

With ThisWorkbook.Sheets("Tum_Sayfa")
For x = 1 To 15
    .Columns(x + 3).ColumnWidth = ThisWorkbook.Sheets("IVL").Columns(x).ColumnWidth
Next x
    .Columns(1).ColumnWidth = 10.14
    .Columns(2).ColumnWidth = 105.14
    .Columns(3).ColumnWidth = 9.14
    .Columns("A:C").Font.Bold = True
    .Columns(1).NumberFormat = "#,##0"

End With

Application.CutCopyMode = False

End Function
Cevapla
#6
bu da renkli)
Visual Basic Code
Function VeriAktar()

'hy_______________________________________Sayfa Resetleme
    With ThisWorkbook.Sheets("Tum_Sayfa")
    LastRow = .Cells(.Rows.Count, "D").End(xlUp).Row + 10
        .Range("A2:O" & LastRow).UnMerge
        .Range("A2:O" & LastRow).Clear
        .Cells.UseStandardHeight = True
        .Cells.UseStandardWidth = True
    End With
'hy________________________________________BİTTİ
Dim Aralik() As Variant
Dim Rng As Range, Hucr As Range
Dim AnaSht As Worksheet, HdfSht As Worksheet


    Set AnaSht = ThisWorkbook.Sheets("IVL")
    Set HdfSht = ThisWorkbook.Sheets("Tum_Sayfa")
    
    Set Rng = AnaSht.Range("A:A")
        SonStr = Rng.Rows(Rng.Rows.Count).End(xlUp).Row 'burada sadece ilk sütundaki veriye bakar
    Set Rng = Rng.Worksheet.Range("A2:A" & SonStr)

'hy___________________________________________________________________Bold IVL değerlerinin adresleri diziye aktarıldı
    For Each Hucr In Rng
        If Hucr.Font.Bold = True And IsNumeric(Hucr.Value) = True Then
            ReDim Preserve Aralik(x)
            Aralik(x) = Hucr.Row
            x = x + 1
        End If
    Next Hucr
            ReDim Preserve Aralik(x)
            Aralik(x) = SonStr + 2
'hy___________________________________________________________________BİTTİ
    

Dim KynkRng As Range
Set HdfRng = HdfSht.Range("D:D")
'hy_________________________________________________________________________Veri AKtarma
For x = LBound(Aralik) To UBound(Aralik) - 1
    Set KynkRng = AnaSht.Range("A" & Aralik(x) & ":O" & Aralik(x + 1) - 2)
    SonStrHdf = HdfRng.Rows(HdfRng.Rows.Count).End(xlUp).Row + 2
    SonStrHdf = IIf(SonStrHdf = 3, 2, SonStrHdf)
        KynkRng.Copy
        HdfSht.Range("D" & SonStrHdf).PasteSpecial xlPasteAll
        SonStrHdf2 = HdfRng.Rows(HdfRng.Rows.Count).End(xlUp).Row
    Set KynkRng = KynkRng.Offset(, 11)
        HdfSht.Rows(SonStrHdf2).RowHeight = KynkRng.Rows(KynkRng.Rows.Count).End(xlUp).Offset(1, -11).RowHeight

            HdfSht.Range("A" & SonStrHdf) = AnaSht.Range("A" & Aralik(x))
            HdfSht.Range("B" & SonStrHdf) = AnaSht.Range("B" & Aralik(x))
            HdfSht.Range("C" & SonStrHdf) = AnaSht.Range("L" & Aralik(x))
            HdfRng.Worksheet.Range("A" & SonStrHdf).Interior.ColorIndex = 3
            HdfRng.Worksheet.Range("D" & SonStrHdf & ":O" & SonStrHdf2).Interior.ColorIndex = 3

    Set IRange = HdfSht.Range("A" & SonStrHdf & ":" & "C" & SonStrHdf)

            For Each iCells In IRange
                iCells.BorderAround LineStyle:=xlContinuous, Weight:=xlThin
            Next iCells
Next x

'hy__________________________"Tum_Sayfa" düzenleme
With ThisWorkbook.Sheets("Tum_Sayfa")
For x = 1 To 15
    .Columns(x + 3).ColumnWidth = ThisWorkbook.Sheets("IVL").Columns(x).ColumnWidth
Next x
    .Columns(1).ColumnWidth = 10.14
    .Columns(2).ColumnWidth = 105.14
    .Columns(3).ColumnWidth = 9.14
    
    .Columns("A:C").Font.Bold = True
    .Columns(1).NumberFormat = "#,##0"

End With

Application.CutCopyMode = False
MsgBox "İşlem Tamam"
End Function
Cevapla

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

Yorum yapmak için üye olmanız gerekiyor

ya da