• DİKKAT

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

Kod birleştirme

ASLAN7410

ASLAN7410

Katılım
15 Temmuz 2012
Mesajlar
2,802
Excel Vers. ve Dili
Ofis 2021 TR 64 Bit
Merhaba hayırlı geceler.

Aşağıdaki kodları bir başlık altında birleştirmek istiyorum, deniyorum bir türlü çalıştıramadım.
Yardımcı olur musunuz?

Kod: 
[B]Private Sub Worksheet_SelectionChange(ByVal Target As Range)[/B]
For Each Item In Selection
If Mid(Item.Formula, 1, 1) = "=" Then
Cells(Target.Row, "C").Activate
End If
Next
End Sub

Kod: 
[B]Private Sub Worksheet_SelectionChange(ByVal Target As Range)[/B]
If Intersect(Target, Range("B3:C1048576")) Is Nothing Then
    Cells.FormatConditions.Delete
    Dim Satır As Range, Sütun As Range
    Set Satır = Range(Cells(ActiveCell.Row, 1), Cells(ActiveCell.Row, 3))
    Set Sütun = Range(Cells(Target.Row, ActiveCell.Column), Cells(1, ActiveCell.Column))
    Cells.FormatConditions.Delete
Application.ScreenUpdating = False
Application.DisplayAlerts = False
    
    With Satır
        .FormatConditions.Delete
        .FormatConditions.Add Type:=xlExpression, Formula1:=1
        .FormatConditions(1).Font.Bold = True
        .FormatConditions(1).Interior.Color = RGB(204, 236, 255)
    End With
End If
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Kod: 
[B]Private Sub Worksheet_SelectionChange(ByVal Target As Range[/B])
If Intersect(Target, Range("D3:P1048576")) Is Nothing Then
For sat = 3 To Cells(Rows.Count, 1).End(3).Row
    For sut = 4 To Month(Now) + 3
        If Cells(sat, sut) = 0 Or Cells(sat, sut) = "" Then
            Cells(sat, sut).Interior.Color = vbRed
        Else
            Cells(sat, sut).Interior.Color = xlNone
        End If
    Next
Next
End If

End Sub
 
Merhaba.

Daha evvel açtığınız koşullu biçimlendirme ile ilgili AİDAT isimli belgenizde mi kullanacaksınız?
Benim verdiğim çözüme ilave isteğinizi net şekilde ifade edin isterseniz.

Yanlış anlamıyorsam, ilave isteğiniz formüllerin silinmesini engellemek sanırım.
.
 
Sayın Ömer Bey hayırlı geceler. Evet aidat programı için yapmaya çalışıyorum.

Alttaki başlık altında,

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Range("B3:C1048576")) Is Nothing Then


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Range("D3:P1048576")) Is Nothing Then

siyahla olan kısımlara göre çalıştırmak istiyorum, bir türlü olmadı.
 
Sayın Ömer Bey önceki çözümde, aşağıdaki gibi çalıyordu, oysa bunları farklı sütunlarda çalışmasını istediğimde olmadı.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Range("D3:P1048576")) Is Nothing Then
 
Onu sormuyorum Sayın ASLAN.

İsteğiniz nedir?
-- A,B ve C sütunları seçildiğinde ne olacak?
-- İçinde bulunulan aydan sonraki aya ait bir sütundaki hücre seçilince ne olacak?
-- A sütunu boş olan satır seçildiğinde ne olacak?
-- Toplam satırı veya toplam sütunu seçildiğinde ne olacak?
gibi seçeneklere göre net ifade etmelisiniz ki;
çözüm üzerinde düşünülebilsin değil mi?
 
Sayın Ömer Bey, aşağıdaki kodda B3 ile C1048576 hücrelerden birisine tıkladığımda, A,B,C sütunlarındaki aktif satırın renklenmesini istiyorum.

Kod: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Range("B3:C1048576")) Is Nothing Then
    Cells.FormatConditions.Delete
    Dim Satır As Range, Sütun As Range
    Set Satır = Range(Cells(ActiveCell.Row, 1), Cells(ActiveCell.Row, 3))
    Set Sütun = Range(Cells(Target.Row, ActiveCell.Column), Cells(1, ActiveCell.Column))
    Cells.FormatConditions.Delete
Application.ScreenUpdating = False
Application.DisplayAlerts = False
    
    With Satır
        .FormatConditions.Delete
        .FormatConditions.Add Type:=xlExpression, Formula1:=1
        .FormatConditions(1).Font.Bold = True
        .FormatConditions(1).Interior.Color = RGB(204, 236, 255)
    End With
End If
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Yine aşağıdaki kodda D3 ile P1048576 hücrelerden birisine tıkladığımda sizin daha önceden yazmış olduğunuz kodun çalışmasını istiyorum. Önceden bu kodlar tek bir başlık altında ve sadece D3 ile P1048576 bu hücre aralığında olduğunda bütün hepsi çalışıyordu. Bu kodlara B3:C1048576 bu aralıkta çalışan kodlarıda ekleyince çalışmadı.

Kod: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Range("D3:P1048576")) Is Nothing Then
For sat = 3 To Cells(Rows.Count, 1).End(3).Row
    For sut = 4 To Month(Now) + 3
        If Cells(sat, sut) = 0 Or Cells(sat, sut) = "" Then
            Cells(sat, sut).Interior.Color = vbRed
        Else
            Cells(sat, sut).Interior.Color = xlNone
        End If
    Next
Next
End If

End Sub
 
Sayın Ömer Bey hazırladığım örneği ekte gönderiyorum. Bu kodlarıda ekledim ama sizin sonradan eklediğiniz kodları çalıştıramadım.
 

Ekli dosyalar

Yanlış anlamadıysam önceki belgenizi yeniden düzenledim.
Yeni halini bir deneyin isterseniz.

Son eklediğiniz belgeye bakmadım.
 

Ekli dosyalar

Sayın Ömer BARAN,


Günaydın.

Dosyayı açarken:
Private Sub Workbook_Open () penceresinde,
aşağıda gözüken hata iletilerini alıyorum.

ActiveWindow.Zoom = 100 satırı sarı renkleniyor ve

"Run-time error '424':
Object required"

ile

"Run-time error '91':
Object variable or With block variable not set"


Ne yapmam gerekiyor?
 

Ekli dosyalar

  • AçılıştakiHata_2017-05-10_07h43_50.jpg
    AçılıştakiHata_2017-05-10_07h43_50.jpg
    19.5 KB · Görüntüleme: 3
Son düzenleme:
Sayın Ömer Bey, benim istediğim bu şekilde değildi, yapmak istediğim 6. ve 7. mesajımda izah etmeye çalışmıştım.
 
Sayın arkadaşlar konu günceldir. Aşağıdaki gibi kodlar çalışmıyor. Siyahla belirttiğim hücrelere göre kodların çalışmasını istiyorum, yardımcı olur musunuz?

Kod: 
[SIZE="2"]Private Sub Worksheet_SelectionChange(ByVal Target As Range)
For Each Item In Selection
If Mid(Item.Formula, 1, 1) = "=" Then
Cells(Target.Row, "C").Activate
End If
Next


[B]If Intersect(Target, Range("B3:C1048576")) Is Nothing Then[/B]

    Cells.FormatConditions.Delete
    Dim Satır As Range, Sütun As Range
    Set Satır = Range(Cells(ActiveCell.Row, 1), Cells(ActiveCell.Row, 3))
    Set Sütun = Range(Cells(Target.Row, ActiveCell.Column), Cells(1, ActiveCell.Column))
    Cells.FormatConditions.Delete
Application.ScreenUpdating = False
Application.DisplayAlerts = False
    
    With Satır
        .FormatConditions.Delete
        .FormatConditions.Add Type:=xlExpression, Formula1:=1
        .FormatConditions(1).Font.Bold = True
        .FormatConditions(1).Interior.Color = RGB(204, 236, 255)
    End With
End If
Application.ScreenUpdating = True
Application.DisplayAlerts = True


[B]If Intersect(Target, Range("D3:P1048576")) Is Nothing Then[/B]

For sat = 3 To Cells(Rows.Count, 1).End(3).Row
    For sut = 4 To Month(Now) + 3
        If Cells(sat, sut) = 0 Or Cells(sat, sut) = "" Then
            Cells(sat, sut).Interior.Color = vbRed
        Else
            Cells(sat, sut).Interior.Color = xlNone
        End If
    Next
Next
End If

End Sub[/SIZE]
 
Son düzenleme:
Sayın arkadaşlar, 11.mesajımdaki gibi yapmaya çalışıyorum, ama bir türlü olmuyor.

Konu günceldir, yardımcı olur musunuz?
 
Deneyiniz.

İstediğiniz sonucu vermeyebilir. Düzeltme yapabiliriz.

Kod: 
Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim Veri As Range, X As Long, Y As Integer
    Dim Satır As Range, Sütun As Range
    
    Application.ScreenUpdating = False
    
    For Each Veri In Selection
        If Veri.HasFormula Then
            MsgBox "Bu hücrede formül var, silmeyin ! . .", vbInformation, "A S L A N"
            Cells(Target.Row, "C").Activate
            Exit Sub
        End If
    Next
    
    If Not Intersect(Target, Range("B3:C1048576")) Is Nothing Then
        Range("A:C").FormatConditions.Delete
        Set Satır = Range(Cells(ActiveCell.Row, 1), Cells(ActiveCell.Row, 3))
        Set Sütun = Range(Cells(Target.Row, ActiveCell.Column), Cells(1, ActiveCell.Column))
        
        With Satır
            .FormatConditions.Delete
            .FormatConditions.Add Type:=xlExpression, Formula1:=1
            .FormatConditions(1).Font.Bold = True
            .FormatConditions(1).Interior.Color = RGB(204, 236, 255)
        End With
    End If
    
    If Not Intersect(Target, Range("D3:P1048576")) Is Nothing Then
        For X = 3 To Cells(Rows.Count, 1).End(3).Row
            For Y = 4 To Month(Now) + 3
                If Cells(X, Y) = 0 Or Cells(X, Y) = "" Then
                    Cells(X, Y).Interior.Color = vbRed
                Else
                    Cells(X, Y).Interior.Color = xlNone
                End If
            Next
        Next
    End If

    Application.ScreenUpdating = True
End Sub
 
Sayın Korhan Bey valla süper oldu, ellerinize sağlık çok teşekkür ediyorum, kaç gündür bir türlü düzeltemiyordum.

İstediğim sonucu veriyor, kodların çalışması için kodların başına aşağıdaki gibi eklemek mi gerekiyor du?

Kod: 
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim Veri As Range, X As Long, Y As Integer
    Dim Satır As Range, Sütun As Range
 
Ben genelde değişken tanımlamalarını yapıyorum. Kendimi bu şekilde alıştırdım.
 
Sayın Korhan Bey Allah razı olsun, çok teşekkür ediyorum, hayırlı geceler, hayırlı çalışmalar diliyorum.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst