• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Yazı karakterine göre veri listeleme

Emir Hüseyin Çoban

Destek Ekibi
Destek Ekibi
Katılım
11 Ağustos 2008
Mesajlar
5,891
Excel Vers. ve Dili
Office 2013 Tr - Win10 x64
Merhaba Arkadaşlar,

Sayfa1 de tarih ve notlar sütununa girilen veriler var. Bazı notların yazı tipi kalın.

Sayfa3 de tarih aralığı girerek yazı tipi kalın olan notları buton kullanarak listele bilirmiyiz.

Yardım ve fikirlerinizi bekliyorum.
 
Son düzenleme:
yanıt

Kod:
Sub listele()
Dim sat As Integer
Sayfa3.[b3:b1000] = ""
s = 3
    For sat = 2 To Sayfa1.Cells(65536, "a").End(xlUp).Row
        If Sayfa1.Cells(sat, "a") >= Sayfa3.[b1] And Sayfa1.Cells(sat, "a") <= Sayfa3.[b2] _
        And Sayfa1.Cells(sat, "a").Font.Bold = True Then
            Sayfa3.Cells(s, "b") = Sayfa1.Cells(sat, "b").Value
            s = s + 1
        End If
    Next
End Sub
 

Ekli dosyalar

Teşekkürler N.Ziya Hiçdurmaz tam istediğim gibi olmuş, sorunsuz çalışıyor.
Açıkcası excelin böyle birşey yapabileceği düşünmemiştim, yapılabilir mi diye düşünüyordum.
Sizin sayenizde oldu, tşkler.
 
Sub listele()
Dim sat As Integer
Sayfa3.[c3:c1000] = ""
s = 3
For sat = 2 To Sayfa1.Cells(65536, "a").End(xlUp).Row
If Sayfa1.Cells(sat, "a") >= Sayfa3.[b1] And Sayfa1.Cells(sat, "a") <= Sayfa3.[b2] _
And Sayfa1.Cells(sat, "a").Font.Bold = True Then
Sayfa3.Cells(s, "c") = Sayfa1.Cells(sat, "b").Value
s = s + 1
End If
Next
End Sub

Daha önce fark etmemiştim ama tabloda uygulamalı görünce fark ettim.
Notlar sorunsuz olarak geliyor, ilgili notların tarihlerinide getirmemiz mümkün mü?

Bunun için hangi kodları eklemeliyim?
 
Son düzenleme:
yanıt

Kod:
Sub listele()
Dim sat As Integer
Sayfa3.[c3:c1000] = ""
s = 3
    For sat = 2 To Sayfa1.Cells(65536, "a").End(xlUp).Row
        If Sayfa1.Cells(sat, "a") >= Sayfa3.[b1] And Sayfa1.Cells(sat, "a") <= Sayfa3.[b2] _
        And Sayfa1.Cells(sat, "a").Font.Bold = True Then
            Sayfa3.Cells(s, "b") = Sayfa1.Cells(sat, "a").Value
            Sayfa3.Cells(s, "c") = Sayfa1.Cells(sat, "b").Value
            s = s + 1
        End If
    Next
End Sub
 
Tekrardan çok teşekkür ederim N.Ziya Hiçdurmaz,
2.kez size zahmet verdim ama tabloyu kullanınca fark ettim.
İyi akşamlar dilerim, İyi Bayramlar
 
Veri girilen hücrelere kenarlık ekleme

Sorgu sayfasında daha önce bir kaç satıra kenarlık eklemiştim.
Ancak veri girişi olan satırlara kenarlık ekletmemiz mümkün mü ?
(Bu düzenleme ile kullanış açısından daha iyi olacağını düşünüyorum, tabloyu kullandıkça fark ediliyor böyle şeyler)

Sub listele()
Dim sat As Integer
Sayfa3.[c3:c1000] = ""
s = 3
Sayfa3.[b3:b1000] = ""
s = 3
For sat = 2 To Sayfa1.Cells(65536, "a").End(xlUp).Row
If Sayfa1.Cells(sat, "a") >= Sayfa3.[b1] And Sayfa1.Cells(sat, "a") <= Sayfa3.[b2] _
And Sayfa1.Cells(sat, "a").Font.Bold = True Then
Sayfa3.Cells(s, "b") = Sayfa1.Cells(sat, "a").Value
Sayfa3.Cells(s, "c") = Sayfa1.Cells(sat, "b").Value
s = s + 1
End If
Next
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [b3:c100]) Is Nothing Then Exit Sub
Target.Borders.LineStyle = 1
End Sub

Kodları ekledim ancak kırmızı ile belirttiğim hücrelerden veri aldığı için 1000 satıra kenarlık ekliyor, sonuç sayfasında veri girişi yapılan hücrelere kenarlık ekletmek için kodlarda nasıl bir düzenleme yapmalıyım.

"Sorgu" sayfasında c1 ve c2 hücrelerine tarih girip sorgulama yaptırınca o tarihte "tümgörevler" sayfasında yazı tipi kalın olan kalmamış ise " yapılmayan görev kalmamıştır " diye uyarı vermesini sağlaya bilirmiyiz.
 
Son düzenleme:
Geri
Üst