• DİKKAT

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

Kod düzenleme

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

Ekte gönderdiğim excel dosyamdaki makrolar gayet güzel çalışıyor, ancak aşağıdaki makro satırını değiştirdiğim zaman çalışmıyor.

Kod:
If Intersect(Target, Range("B2:F" & Rows.Count)) Is Nothing Then Exit Sub

Bu şekilde yaptığım zaman çalışmıyor.

Kod:
If Intersect(Target, Range("B2:B,F2:F" & Rows.Count)) Is Nothing Then Exit Sub

Yardımcı olur musunuz?

Kodun tamamı.
Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo 10
    [B]If Intersect(Target, Range("B2:F" & Rows.Count)) Is Nothing Then Exit Sub[/B]
    Application.EnableEvents = False
    
    Select Case Target.Column
        Case 2, 6
        Target = UCase(Replace(Replace(Target, "i", "İ"), "ı", "I"))
    End Select
    
    Sheets(1).Range("A2:A" & [A1048576].End(3).Row).ClearContents
    son = Cells.Find("*", , , , xlByRows, xlPrevious).Row
    Range("A2") = 1
    Range("A2").AutoFill Destination:=Range("A2:A" & son), Type:=xlFillSeries
    Sheets(1).Range("A1:F1048576").Borders.LineStyle = xlNone 'Kenarlık sil
    Sheets(1).Range("A1:F" & [B1048576].End(3).Row).Borders.LineStyle = xlContinuous 'Kenarlık
    
10
    Application.EnableEvents = True
End Sub
 

Ekli dosyalar

Merhaba;
İlgili satırı;

If Intersect(Target, Range("B2:B" & Rows.Count, "F2:F" & Rows.Count)) Is Nothing Then Exit Sub

Şeklinde düzenleyin.

İyi çalışmalar.
 
Sayın muygun, ilginiz için çok teşekkür ediyorum, ellerinize sağlık, sayenizde gayet güzel oldu.

Göndermiş olduğum örnekteki kodda şöyle bir sıkıntı çıkıyor, F sütunundan sonraki sütunlardaki hücrelerde veriler mevcut, B sütunu ve F sütununa bilgi girildiğinde F sütunundan sonraki sütunlardaki verileri A sütunundaki sıra numarası veren kod görüyor ve en son satıra kadar sayı veriyor.

Sıra numarasını veren koduda B ve F sütununa göre ayarlayabilir misiniz?
 
Sayın muygun, sizin göndermiş olduğunuz koda başka sayfadaki kodlarda bulunan H sütunu için de ekleme yapınca hata mesajı verdi.

Kod:
If Intersect(Target, Range("B2:B" & Rows.Count, "F2:F" & Rows.Count, [B]"H2:H" & Rows.Count[/B])) Is Nothing Then Exit Sub
 

Ekli dosyalar

  • Ekran Alıntısı.JPG
    Ekran Alıntısı.JPG
    92.1 KB · Görüntüleme: 3
Merhaba;
Tam anlayamadım ama;

Private Sub Worksheet_Change(ByVal Target As Range)
sat = Target.Row
On Error GoTo 10
If Intersect(Target, Range("B2:B" & Rows.Count, "F2:F" & Rows.Count)) Is Nothing Then Exit Sub
Application.EnableEvents = False

Select Case Target.Column
Case 2, 6
Target = UCase(Replace(Replace(Target, "i", "İ"), "ı", "I"))
End Select

Sheets(1).Range("A2:A" & [A1048576].End(3).Row).ClearContents
son = Cells.Find("*", , , , xlByRows, xlPrevious).Row
Range("A2") = 1
Range("A2").AutoFill Destination:=Range("A2:A" & son), Type:=xlFillSeries
Sheets(1).Range("A1:F1048576").Borders.LineStyle = xlNone 'Kenarlık sil
Sheets(1).Range("A1:F" & [B1048576].End(3).Row).Borders.LineStyle = xlContinuous 'Kenarlık

10
Cells(sat, 1) = sat - 1
Application.EnableEvents = True
End Sub

Şeklinde bir deneyin.
 
Sayın muygun, ellerinize sağlık çok teşekkür ediyorum.

4. mesajımdaki hatayı veriyor.
 
Range ifadesine 2 değişken tanımlanır diye biliyorum. Sizde 3 olmuş. B,F ve H.
 
Sayın Şaban Bey, ilginiz için çok teşekkür ediyorum.

Peki kodu nasıl 3 sütuna uygularız?
 
Özel üye olmadığımdan dosyanızı inceleyemiyorum. Bir upload sitesine ekleme şansınız olursa bir bakayım. Elimden bir şey gelirse ...
 
İstediğinizi tam olarak anlayamamakla birlikte, kodu aşağıdaki şekilde değiştirerek bir dener misiniz.

Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo 10
    If Intersect(Target, Range("B2:B" & Rows.Count)) Is Nothing Then
    If Intersect(Target, Range("F2:F" & Rows.Count)) Is Nothing Then
    If Intersect(Target, Range("H2:H" & Rows.Count)) Is Nothing Then
    Exit Sub
    End If
    End If
    End If
    Application.EnableEvents = False
    
    Select Case Target.Column
        Case 2, 6
        Target = UCase(Replace(Replace(Target, "i", "İ"), "ı", "I"))
    End Select
    
    Sheets(1).Range("A2:A" & [A1048576].End(3).Row).ClearContents
    son = Cells.Find("*", , , , xlByRows, xlPrevious).Row
    Range("A2") = 1
    Range("A2").AutoFill Destination:=Range("A2:A" & son), Type:=xlFillSeries
    Sheets(1).Range("A1:F1048576").Borders.LineStyle = xlNone 'Kenarlık sil
    Sheets(1).Range("A1:F" & [B1048576].End(3).Row).Borders.LineStyle = xlContinuous 'Kenarlık
    
10
    Application.EnableEvents = True
End Sub
 
Sayın Şaban Bey, çok teşekkür ediyorum, sütunları ayrı ayrı yazmak gerekiyor demek ki.

Hayırlı geceler diliyorum.
 
İşiniz görüldüyse ne mutlu. Hayırlı geceler...
 
Geri
Üst