• DİKKAT

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

Veri Alanını seçmek

Katılım
10 Kasım 2006
Mesajlar
1,288
Excel Vers. ve Dili
Excel-2016
Değerli Arkadaşlar..!
(A:D, 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..
 
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.
 
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..)
 
Ş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.
Kod:
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
 
Merhaba @EKREM1661

Bu şekilde deneye bilirsinmisiniz.
Kod:
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
 
Merhaba,

Alternatif olsun. ( ToggleButton için)
Kod:
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
 
Ö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.
 
Ö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 A1:D40 alanı için uygulama yapmak istersek nasıl düzenlenir.
 
Deneyiniz.

C++:
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
 
Üstad.. Elleriniz dert görmesin..!
 
Geri
Üst