Veri Alanını seçmek

[EKREM1661]

Değerli Arkadaşlar..!
(A, F:Z, AD:AR, AT:BM) sütun aralıklarını, 6.ncı satırdan itibaren, veri bulunan son satıra kadar nasıl seçerim.?
Sonra bu seçtiğim alanın zemin rengini siyah, metin rengini de beyaz yapmak için..

 

[Ömer]

Merhaba,

Her aralığın son satırına kadar mı? Yoksa verilen aralıkları bütün düşünerek tüm aralığın en son satırına göre mi seçim olacak.

 

[EKREM1661]

Evet hocam.. Her aralığın aynı hizalı son satırına kadar.. (sonra bu seçimi ToggleButton düğmesine atayarak, istediğimiz zaman (siyah zemin-beyaz metin) biçimine döndüreceğiz.. görme bozukluğu-beyaz ekranı görememe sorunu olan bir personel için gerekiyor..)

 

[AdemCan]

Şu kodlar kullanılabilir ama biraz uzun oldu, alternatifler ile daha işlevsel olanları gelecektir.
Örnek olarak satırlarda kodların açıklaması da yer almaktadır.

Sub alan_sec_renklendir()
Application.ScreenUpdating = True

'A sütunundaki son dolu satır numarası
son_satir = Range("A" & Rows.Count).End(xlUp).Row

'hücrelerin dolgu rengini temizler
Cells.Interior.Color = xlNone

'hücrelerin yazı tipi rengini siyah yapar
Cells.Font.Color = vbBlack

'Son dolu hücresnin satır numarasına göre A6 ile D sütununda aralık belirler ve aralığın adresini alır
alan1 = Range("A6:D" & son_satir).Address
alan2 = Range("F6:Z" & son_satir).Address
alan3 = Range("AD6:AR" & son_satir).Address
alan4 = Range("AT6:BM" & son_satir).Address

'"A6:D" aralığı
Range(alan1).Interior.Color = vbBlack 'Hücre dolgu rengi siyah
Range(alan1).Font.Color = vbWhite ' Hücre Yazı tipi rengi beyaz

'"F6:Z" aralığı
Range(alan2).Interior.Color = vbBlack
Range(alan2).Font.Color = vbWhite

'"AD6:AR" aralığı
Range(alan3).Interior.Color = vbBlack
Range(alan3).Font.Color = vbWhite

'"AT6:BM" aralığı
Range(alan4).Interior.Color = vbBlack
Range(alan4).Font.Color = vbWhite

Application.ScreenUpdating = False
End Sub

 

[Hepgel]

Merhaba @EKREM1661

Bu şekilde deneye bilirsinmisiniz.

Sub SUTUNLAR_BICIM()
Cells.Interior.Color = xlNone: Cells.Font.Color = xlAtumatic
For s = 1 To 65
    If s = 5 Or s = 45 Then s = s + 1
    If s = 27 Then s = s + 3
    a = Cells(Rows.Count, s).End(3).Row
    If a > 6 Then
        Range(Cells(6, s), Cells(a, s)).Interior.ColorIndex = 1
        Range(Cells(6, s), Cells(a, s)).Font.ColorIndex = 2
    End If
Next
End Sub

 

[Ömer]

Merhaba,

Alternatif olsun. ( ToggleButton için)

Private Sub ToggleButton1_Click()

    Dim d(), s As Long, i As Byte, sat As Long
    
    s = Rows.Count
    d = Array("A6:D" & s, "F6:Z" & s, "AD6:AR" & s, "AT6:BM" & s)

    If ToggleButton1.Value = False Then
        For i = 0 To UBound(d)
            With Range(d(i))
                .Interior.Color = xlNone
                .Font.Color = vbBlack
            End With
            On Error Resume Next
            sat = Range(d(i)).Find("*", , , , xlByRows, xlPrevious).Row
            If Err.Number = 0 Then
                With Range(Replace(d(i), s, sat))
                    .Interior.Color = vbBlack
                    .Font.Color = vbWhite
                End With
            End If
        Next i

        ToggleButton1.Caption = "Siyah_Beyaz"
    Else
        For i = 0 To UBound(d)
            With Range(d(i))
                .Interior.Color = xlNone
                .Font.Color = vbBlack
            End With
        Next i
        ToggleButton1.Caption = "Normal"
    End If

End Sub

 

[EKREM1661]

Ömer üstadım..! sizin yazdığınız kodu kullanacağım, kusursuz olmuş, çok teşekkürler ve elinize sağlık hocam... Diğer ilgilenen (hepgel, faye_efsane) arkadaşlara da teşekkürler, inceleme açısından faydalı oldu.

 

[EKREM1661]

Ömer hocam, sizi istemeyerek de olsa tekrar meşgul ediyorum. Yukarıdaki kodu belirli bir alan için benzer bir işte uygulamak istedim, hata verdi. Örneğin sadece sayfanın A140 alanı için uygulama yapmak istersek nasıl düzenlenir.

 

[Korhan Ayhan]

Deneyiniz.

Option Explicit

Private Sub ToggleButton1_Click()
    Select Case ToggleButton1
        Case False
            Range("A1:D40").Font.ColorIndex = False
            Range("A1:D40").Interior.ColorIndex = False
        Case True
            Range("A1:D40").Font.ColorIndex = 2
            Range("A1:D40").Interior.ColorIndex = 1
    End Select
End Sub

 

[EKREM1661]

Üstad.. Elleriniz dert görmesin..!