Mükerrer Kayıtı bulma!

[TanerSaydam]

Merhaba arkadaşlar, Her gün için bir sayfa oluşturduğum bir excel dosyam var. Bu dosyada her gün irsaliye kesiyoruz ve her irsaliye için fatura numarası veriyorum. Bir makro ile yazdığım fatura numarası daha önce yazılmışsa beni uyarsın istiyorum. Aşağıdaki kodu yazdım ama sadece aktif sayfada arıyor. Bana tüm çalışma kitabında araması lazım. Yardımlarınızı bekliyorum.

Şimdiden teşekkürler.

Sub fat_numara_ara()
'
' fat_numara_ara Makro
'
' Klavye Kısayolu: Ctrl+e
'
    ilk = 2
    son = Range("C" & Rows.Count).End(3).Row
    
    For a = ilk To son
    x = Range("F" & a).Value
    ksat = Range("F" & a).Row
    ksut = Range("F" & a).Column
    Cells.Find(What:=x, After:=ActiveCell, LookIn:=xlValues, LookAt _
        :=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        True, SearchFormat:=False).Activate
    sat = ActiveCell.Row
    sut = ActiveCell.Column
    y = sat & "-" & sut
    If sat = ksat And sut = ksut Then
    Else
    MsgBox "Mükerrer kayıt hatası", vbOKOnly + vbCritical, "UYARI"
    Cells(sat, sut).Select
    End
    End If
    Next a
If a = son + 1 Then
MsgBox "Mükrerrer numara yok.", vbOKOnly + vbInformation, "Tasarlayan: Taner Saydam!"
End If
End Sub

 

[Korhan Ayhan]

Merhaba,

2-3 sayfalık küçük bir örnek dosya ekler misiniz?

 

[TanerSaydam]

Merhaba,

2-3 sayfalık küçük bir örnek dosya ekler misiniz?

Dosya ekte. Örneğin 23525 yazdığımda, diğer sayfalarda bu numara var mı otomatik aramasını istiyorum.

 

[Korhan Ayhan]

Deneyiniz.

Kodu "ThisWorkbook" ya da "BuÇalışmaKitabı" bölümüne uygulayınız.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim Sayfa As Worksheet, Bul As Range
        
    If Intersect(Target, Range("F2:F" & Rows.Count)) Is Nothing Then Exit Sub
    If Target = "" Then Exit Sub
    
    Application.EnableEvents = False
        
    For Each Sayfa In ThisWorkbook.Worksheets
        If Sayfa.Name <> Sh.Name Then
            Set Bul = Sayfa.Range("F:F").Find(Target, , , xlWhole)
            If Not Bul Is Nothing Then
                MsgBox "Mükerrer kayıt tespit edilmiştir." & Chr(10) & Chr(10) & _
                       "Bulunan sayfa adı ; " & Sayfa.Name & Chr(10) & _
                       "Bulunan hücre adresi ; " & Bul.Address(0, 0), vbCritical
                Target.Select
                Target = ""
                GoTo Son
                Exit Sub
            End If
        Else
            If WorksheetFunction.CountIf(Range("F:F"), Target) > 1 Then
                Set Bul = Sayfa.Range("F1:F" & Target.Row - 1).Find(Target, , , xlWhole)
                If Not Bul Is Nothing Then
                    MsgBox "Mükerrer kayıt tespit edilmiştir." & Chr(10) & Chr(10) & _
                           "Bulunan sayfa adı ; " & Sayfa.Name & Chr(10) & _
                           "Bulunan hücre adresi ; " & Bul.Address(0, 0), vbCritical
                    Target.Select
                    Target = ""
                    GoTo Son
                    Exit Sub
                End If
            End If
        End If
    Next

Son: Application.EnableEvents = True
End Sub

 

[TanerSaydam]

Ellerine sağlık hocam, ufak bir pürüz kaldı. Aynı sayfada arama yapmamasının imkanı var mı? Çünkü farklı irsaliyelere aynı numarayı verdiğim durumlar oluyor. Aramayı sadece diğer sayfalarda yapsa?

Edit: Birde arama yaparken yazdığım fat numarasının -1'ini aramaya yapsa ve eğer bulamasa uyarsa.

Fat numarası atlamamak adına.

 

[Korhan Ayhan]

Deneyiniz.

"ThisWorkbook" bölümüne;

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim Sayfa As Worksheet, Bul As Range, Sayi As Long, Seri As String, Onceki_Fatura_No As String
        
    If Intersect(Target, Range("F2:F" & Rows.Count)) Is Nothing Then Exit Sub
    If Target = "" Then Exit Sub
    
    Sayi = RH(Target.Value, 1)
    Sayi = Sayi - 1
    Seri = RH(Target.Value, 2)
    Onceki_Fatura_No = Seri & Sayi
    
    Application.EnableEvents = False
        
    For Each Sayfa In ThisWorkbook.Worksheets
        Set Bul = Sayfa.Range("F:F").Find(Onceki_Fatura_No, , , xlWhole)
        If Not Bul Is Nothing Then Say = Say + 1
    Next
    
    If Say = 0 Then
        MsgBox "Bir önceki seri numarası girilmemiş !" & Chr(10) & _
               "Lütfen girişlerinizi kontrol ediniz !" & Chr(10) & Chr(10) & _
               "Girilmeyen fatura numarası ; " & Onceki_Fatura_No, vbCritical
        Target.Select
        Target = ""
        GoTo Son
        Exit Sub
    End If
    
    
    For Each Sayfa In ThisWorkbook.Worksheets
        If Sayfa.Name <> Sh.Name Then
            Set Bul = Sayfa.Range("F:F").Find(Target, , , xlWhole)
            If Not Bul Is Nothing Then
                MsgBox "Mükerrer kayıt tespit edilmiştir." & Chr(10) & Chr(10) & _
                       "Bulunan sayfa adı ; " & Sayfa.Name & Chr(10) & _
                       "Bulunan hücre adresi ; " & Bul.Address(0, 0), vbCritical
                Target.Select
                Target = ""
                GoTo Son
                Exit Sub
            End If
        End If
    Next

Son: Application.EnableEvents = True
End Sub

Boş bir modüle;

Public Function RH(Veri As Variant, Optional Kriter As Byte = 1)
    Application.Volatile True
    Karakter = "_|<+-/\*'´`¨~,.:;!^%&<>()[]{}#$@"""
    For X = 1 To Len(Veri)
        If IsNumeric(Mid(Veri, X, 1)) Then
            If InStr(1, Karakter, Mid(Veri, X, 1)) = 0 Then
                Rakam = Rakam & Mid(Veri, X, 1)
                Rakam = Replace(Rakam, "  ", " ")
                If Right(Harf, 1) <> " " And Harf <> "" Then Harf = Harf & " "
            End If
        Else
            If InStr(1, Karakter, Mid(Veri, X, 1)) = 0 Then
                Harf = Harf & Mid(Veri, X, 1)
                Harf = Replace(Harf, "  ", " ")
                If Right(Rakam, 1) <> " " And Rakam <> "" Then Rakam = Rakam & " "
            End If
        End If
    Next
    Select Case Kriter
        Case 1: RH = Trim(Rakam)
        Case 2: RH = Trim(Harf)
        Case Else: RH = "Hata !"
    End Select
End Function

 

[TanerSaydam]

Eline sağlık hocam. Çok güzel oldu.