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
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("DLol")

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)
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("DLol")
'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
Task