Mükerrer kayıt

[ASLAN7410]

Merhaba arkadaşlar.

Aşağıdaki kodu başka bir evrakta kullanıyorum. Bu kod Arşiv sayfasındaki B sütunundaki bilgilerde aynı kayıt varsa uyarıyor.
Gerekli değişiklikleri yaparak yeni bir evrak yapmaya çalışıyorum.

Sub KaydetYazdir()
    Sheets("TESLİM BELGESİ").Activate
    Range("M4").Activate
    Application.Calculation = xlAutomatic
    Application.ScreenUpdating = False

    yazdir = Application.InputBox("Kaç adet yazdırılacak?", "A S L A N", 1)
    If yazdir = False Then
    MsgBox " Yazdırmaktan vazgeçildi.", vbInformation, "A S L A N"
    Sheets("TESLİM BELGESİ").Activate
    Exit Sub
    Else
    ActiveWindow.SelectedSheets.PrintOut Copies:=yazdir, Collate:=True, _
    IgnorePrintAreas:=False
    MsgBox yazdir & " adet yazdırıldı ve ARŞİV'e kaydedildi.", vbInformation, "A S L A N"
    Sheets("TESLİM BELGESİ").Activate
    Range("M4").Activate
    End If

[B]    say = WorksheetFunction.CountIf(Sheets("ARŞİV").[B:B], Sheets("TESLİM BELGESİ").[S1])
    If say > 0 Then
    soru = MsgBox("Mükerrer kayıt!" & vbCrLf & "Kaydetmek istediğiniz bilgiler ARŞİV sayfasında var." & vbCrLf & "Devam etmek istiyor musunuz?", vbInformation + vbYesNo, "ASLAN")
    If soru = vbNo Then
        GoTo son
    ElseIf soru = vbYes Then
        satir = WorksheetFunction.Match(Sheets("TESLİM BELGESİ").Range("S1"), Sheets("ARŞİV").Range("B:B"), 0)
        Sheets("ARŞİV").Range("B" & satir & ":I" & satir) = WorksheetFunction.Transpose(Range("S1:S8"))[/B]
    End If
    Else
    
    Sheets("TESLİM BELGESİ").Activate
    If Range("S1") <> Empty Then
    satir = Sheets("ARŞİV").Cells(Rows.Count, 2).End(3).Row + 1
    Sheets("ARŞİV").Range("b" & satir & ":I" & satir) = WorksheetFunction.Transpose(Range("S1:S8"))
    End If
    
    Sayıverme
End If
son:

    Sheets("TESLİM BELGESİ").Activate
    Temizle
    Range("M4").Activate  

    'ActiveWorkbook.Save
End Sub

Benim istediğim E sütunudaki mükerrer kayıtları görmesini istiyorum.

Yukarıdaki kod içerisindeki kodlardan aşağıdaki kodda "B:B" yazan yerleri "E:E" ye çevirdim ancak bana uyarı vermiyor.
Yapmaya çalıştım ancak yapamadım, yardım edecek arkadaşlara şimdiden teşekkür ederim.

         say = WorksheetFunction.CountIf(Sheets("ARŞİV").[B:B], Sheets("TESLİM BELGESİ").[S1])
    If say > 0 Then
    soru = MsgBox("Mükerrer kayıt!" & vbCrLf & "Kaydetmek istediğiniz bilgiler ARŞİV sayfasında var." & vbCrLf & "Devam etmek istiyor musunuz?", vbInformation + vbYesNo, "ASLAN")
    If soru = vbNo Then
        GoTo son
    ElseIf soru = vbYes Then
        satir = WorksheetFunction.Match(Sheets("TESLİM BELGESİ").Range("S1"), Sheets("ARŞİV").Range("B:B"), 0)
        Sheets("ARŞİV").Range("B" & satir & ":I" & satir) = WorksheetFunction.Transpose(Range("S1:S8"))

 

[ASLAN7410]

Merhaba arkadaşlar aşağıdaki koddaki siyah yerleri deneme yanılma ile değiştirdim oldu. Teşekkürler.

         say = WorksheetFunction.CountIf(Sheets("ARŞİV").[B][E:E][/B], Sheets("TESLİM BELGESİ").[B][S4][/B])
    If say > 0 Then
    soru = MsgBox("Mükerrer kayıt!" & vbCrLf & "Kaydetmek istediğiniz bilgiler ARŞİV sayfasında var." & vbCrLf & "Devam etmek istiyor musunuz?", vbInformation + vbYesNo, "ASLAN")
    If soru = vbNo Then
        GoTo son
    ElseIf soru = vbYes Then
        satir = WorksheetFunction.Match(Sheets("TESLİM BELGESİ").Range[B]("S4")[/B], Sheets("ARŞİV").Range[B]("E:E")[/B], 0)
        Sheets("ARŞİV").Range("B" & satir & ":I" & satir) = WorksheetFunction.Transpose(Range("S1:S8"))

 

[PLİNT]

Merhaba
Sayfa adlarında yanlışlık yoksa;
"E" sütunundaki hücrelerdeki verilerin başında veya sonunda boşluk karakteri olabilir,"ALKE "
aranan "s1" hücresinde olabilir,
Olmazsa şöylede yapabilirsiniz,

'....kodlarınız
Set say = Sheets("ARŞİV").[E:E].Find(Trim(Sheets("TESLİM BELGESİ").[S1]))
If Not say Is Nothing Then
soru = MsgBox ......

 

[ASLAN7410]

Merhaba Sayın PLİNT, hayırlı pazarlar.
Arşiv sayfasındaki E sütunundaki verilerin Teslim belgesindeki S4 hücresinde arandığını, kod yazmaktan anlamadığım için deneme yanılma olarak çözmüştüm.
Sizin yazmış olduğunuz kodlar daha anlaşılır geldiği için sizin kodları kullanıyorum.

Çok teşekkür ediyorum.

say = WorksheetFunction.CountIf(Sheets("ARŞİV").[B][E:E][/B], Sheets("TESLİM BELGESİ").[B][S4][/B])
If say > 0 Then

Sizin kodlarınız.

Set say = Sheets("ARŞİV").[B][E:E][/B].Find(Trim(Sheets("TESLİM BELGESİ").[B][S1][/B]))
If Not say Is Nothing The

n

 

[PLİNT]

Merhaba Sayın PLİNT, hayırlı pazarlar.
Arşiv sayfasındaki E sütunundaki verilerin Teslim belgesindeki S4 hücresinde arandığını, kod yazmaktan anlamadığım için deneme yanılma olarak çözmüştüm.
Sizin yazmış olduğunuz kodlar daha anlaşılır geldiği için sizin kodları kullanıyorum.

Merhaba
Unutmayın, yukarıdaki kod aramayı
Set say = Sheets("ARŞİV").[E:E].Find(Trim(Sheets("TESLİM BELGESİ").[S1]),Lookat:=Xlpart)
şeklinde yapar. Yani "s1" hücresindeki veriyi "E" hücresindeki verinin içinde varsada bulur
mesela "s1=fizik" "e2=metafizik" "e2" de var diye uyarı verir
"Lookat:=xlwhole" kullanırsanız birebir arar,
Dosyanızı bilmediğimizden bu durumu gözönünde bulundurunuz.

 

[ASLAN7410]

Sayın PLİNT çok teşekkür ederim, çok işime yaradı.
İyi günler.