kod çakışması

[86126]

Merhaba Arkadaşlar,
elimde iki kod var birisi süzme ile alakalı diğeride otomatik sıra numarası verme ikisini bir arada kulanamıyorum hata vriyor. Yardımlarınızı bekliyorum.

birinci kod
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [F4:G4]) Is Nothing Then Exit Sub
Call arama(Target, Target.Column)
End Sub

ikinci kod
Private Sub Worksheet_Change(ByVal Target As Range)
Dim X As Long, No As Long

If Intersect(Target, Range("B7:B65536")) Is Nothing Then Exit Sub

Application.ScreenUpdating = False

For X = 7 To Selection.SpecialCells(xlCellTypeLastCell).Row
If Cells(X, "A").MergeArea.Count = 1 Then
If Cells(X, "B") <> "" And Cells(X, "A") <> "Sıra No" Then
No = No + 1
Cells(X, "A") = No
Else
If Cells(X, "A") <> "Sıra No" Then
Cells(X, "A").ClearContents
End If
End If
End If
Next

Application.ScreenUpdating = True
End Sub

 

[Ömer]

Merhaba,

Bu şekilde deneyin.

Private Sub Worksheet_Change(ByVal Target As Range)
 
    Dim X As Long, No As Long
 
    If Intersect(Target, [B4:B65536,F4:G4]) Is Nothing Then Exit Sub
 
    If Target.Column = 2 Then
 
        Application.ScreenUpdating = False
 
        For X = 7 To Selection.SpecialCells(xlCellTypeLastCell).Row
            If Cells(X, "A").MergeArea.Count = 1 Then
                If Cells(X, "B") <> "" And Cells(X, "A") <> "Sıra No" Then
                    No = No + 1
                    Cells(X, "A") = No
                Else
                    If Cells(X, "A") <> "Sıra No" Then
                        Cells(X, "A").ClearContents
                    End If
                End If
            End If
        Next X
 
        Application.ScreenUpdating = True
 
    Else
        Application.EnableEvents = False
            Call arama(Target, Target.Column)
        Application.EnableEvents = True
    End If
 
End Sub

.

 

[86126]

Teşekkür ederim ilginize
Dosyamı ekledim dosya üzerinden bakabilirmisiniz hata verdi çünkü

 

[86126]

Ömer Bey Kod hata verdi yardımınızı bekliyorum. Dosyayı ilk mesaja ekledim.

 

[Ömer]

#2 numaralı mesajı yeniden düzenledim.

 

[86126]

Ömer Bey ilginize teşekkür ederim. Kod yine olmadı hata verdi. 2.Kodu be yanlış yazmışım.

If Intersect(Target, Range("B4:B65536")) Is Nothing Then Exit Sub buradaki B7:B65536 olacak dosya üzerinde bakabilirmisiniz. Acaba diğer kodlarla çakışmamı yapıyor.

 

[Ömer]

Bende herhangi bir hata vermedi. 4 yerine 7 yazmanız yeterli olur.

Ayrıca sayfada bulunan aşağıdaki kodları silmeniz gerekir.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [F4:G4]) Is Nothing Then Exit Sub
Call arama(Target, Target.Column)
End Sub

 

[86126]

Çok teşekkür ederim. Ancak böylede çok yavaş çalışıyor. Ve ilk veri aldığında sıra numarasını yeniden vermiyor.

 

[Ömer]

Bu konun benimle bir alakası yok ben sadece yazdığını iki kodu tek sayfa içinde nasıl yazılacağının örneğini verdim.

Linkte #10 numaralı mesajda konuyla ilgili bir yapı yazmıştım. Sizede uyguladığım sadece bu yapıdır.

http://www.excel.web.tr/f48/kod-bazen-caly-myyor-t109017.html

.