A Sütununda eğer yoksa

[zulfuernek]

A sütununda sayılar mevcut. Mesela 06541. Bu sayının hem bold karakterinde hemde normal karakterde olanları mevcut.

Sorum şöyle: a sütununda bulunan sayıları tarayacak ve mevcut sayıların bold karakterinde olan varsa o satır kalacak. Eğer a sütununda bold karakteri olmayan sayı varsa o satırı silecek

 

[Seyit Tiken]

Bu şekilde bir deneyiniz.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
For a = Cells(65536, 1).End(xlUp).Row To 1 Step -1
If Cells(a, "A").Font.Bold = False Then Rows(Cells(a, "A").Row).Delete
Next
End Sub

 

[zulfuernek]

http://dosya.co/tk6rj0vrmkog/seçeneğe_göre_veri_getir.xlsm.html


hocam yukarıdaki dosyaya uyarlayamadım bi bakmanız mümkünmü?

option button 3 e tıklayınca dediğim olayı gerçekleştirmeli. ktmh sayfasının hepsini alıyor ancak ondan sonra a sütununda bold karakterde olan rakam yoksa o satırı silsin istiyorum

 

[Korhan Ayhan]

"deneme" isimli makro kodunuzu aşağıdaki gibi değiştirip deneyiniz.

Sub deneme()
    Dim Son As Long, X As Long, Satir As Long
    Application.ScreenUpdating = False
    Range("A2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.ClearContents
    Sheets("BCH").Select
    Range("A1:B5000").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("Sayfa1").Select
    Range("A2").Select
    ActiveSheet.Paste
    
    Sheets("KTMH").Select
    Range("A1:B5000").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sayfa1").Select
    Application.Goto Reference:="R65536C1"
    Selection.End(xlUp).Select
    ActiveCell.Offset(1, 0).Range("A1").Select
    Satir = ActiveCell.Row
    ActiveSheet.Paste
    Application.Goto Reference:="R1C1"
    Application.CutCopyMode = False
    Son = Cells(Rows.Count, 1).End(3).Row
    For X = Son To Satir Step -1
        If WorksheetFunction.CountIf(Range("A2:A" & Satir), Cells(X, 1)) = 0 Then
            Rows(X).Delete
        End If
    Next
    Application.ScreenUpdating = True
    MsgBox "TÜM sayfalardaki veriler getirilmiştir"
End Sub

 

[zulfuernek]

Malesef korhan hocam (

 

[zulfuernek]

kod bold karakter olmayan hepsini siliyor. benim istediğim ise ktmh sayfasından verileri çektikten sonra a sütununda ktnh sayfasından gelen normal karekterli yazıarın bold olanı yoksa onu silsin. yani 6 dan sonrası yok mesela onları göstermesin

 

[Korhan Ayhan]

İlk mesajınızı dikkatlice okuyunuz. "A" sütunundaki "Bold" olmayan satırların silinmesini istemişsiniz. Verdiğim kod bu işlemi yapıyor.

 

[zulfuernek]

hocam şöyle tarif etsem daha anlaşılır olur sanırım

BCH sayfasından verileri sayfa 1 e çektik. BCH sayfasında A sütununda olan rakamlardan hangileri KTMH sayfasında varsa onlarıda sayfa 1 e getirsin ve önceden sayfa 1 e eklenen BCH verielerinin sonuna eklesin

 

[Korhan Ayhan]

Üstteki mesajımda ki kodu revize ettim. Tekrar deneyiniz.

 

[zulfuernek]

korhan hocam mikemmell )))). çok çok teşekkür ederim tam istediğim kodlama olmuş elinize emeğinize sabrınıza sağlık. )

 

[zulfuernek]

sayın korhan hocam yukarıda verdiğiniz kod işimi gördü ancak ufak bir değişiklik yapmaya çalıştım fakat başaramadım.

dosya örneğini ekte gönderiyorum. uzun uğraşlar sonucunda textboxdan label filtrelemeyi başardım. ancak sizin verdiğiniz kodu da checkbox olayına eklemek istiyorum.

sağ tarafta bulunan ktmhları varsa ekle checkboxuna tıkladığım zaman "DEVRESONU" sayfasında a sütununda hangi değerler varsa "KTMH" sayfasında aynı kodlara ait satırları çekerek yine "devresonu sayfasında ilk boş hücreye yapıştırsın.

Saygılarımla