• Merhaba Ziyaretçi,
    Microsoft 365 Uygulamaları ile ilgili yeni haberler, dikkat çekici konular, ilgi ile takip edeceğiniz yazılar için.

    Abone Olun
  • ESTE - Microsoft Office Eğitimleri

    Yeni yıl Microsoft Office Eğitim planlarınız için bütçenizi oluşturmadan önce ESTE eğitim kalitesi ile tanışın. 🙌
    Kullanıcıların ihtiyacı olan yazılı materyal, dosya ve video kaynağı desteğimiz ile tüm ofis çalışanlarının iş süreçlerini rahatlatacak eğitimler planlayın. 🎯
    Microsoft Office eğitimlerimiz hakkında detaylı bilgi için bize ulaşın.

    👉 Microsoft Office Eğitim Talebi

Çözüldü Aktarma Esnasında Mükerrer Kontrolü Yapma

Durum
Üzgünüz bu konu cevaplar için kapatılmıştır...

istiklal

Yeni Üye
Katılım
11 Nis 2019
Mesajlar
34
En iyi yanıt
0
Puanları
8
Yaş
49
Konum
Malatya
Ad Soyad
İlhan Yüksel
Office Vers.
Microsoft Office 2016 TR
PHP:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Not Intersect(Target, Range("A3:A65536")) Is Nothing Then
    Range("A3:A65536").Replace "ü", "" 'Araya Ekleyin
        Cancel = True
        With Target
            .Font.Name = "Wingdings"
            .Font.Size = 12
            .HorizontalAlignment = xlCenter
        End With
        If Target.Value = "ü" Then
            Cells(Target.Row, "S") = ""
            Target.Value = ""
            Sheets("Sözleşme").Range("a1") = ""
        Else
            Cells(Target.Row, "S") = Format(Now, "dd.mm.yyyy") ' dddd hh:mm")
            Target.Value = "ü"
           Sheets("Sözleşme").Range("A1") = Target.Next.Value
          
Sheets("KAYIT").Range("A1") = Target.Next.Value
Sheets("SGK BİLDİRİM").Cells(Sheets("SGK BİLDİRİM").Cells(Rows.Count, "B").End(3).Row + 1, "B") = Target.Offset(0, 2)
Sheets("SGK BİLDİRİM").Cells(Sheets("SGK BİLDİRİM").Cells(Rows.Count, "C").End(3).Row + 1, "C") = Target.Offset(0, 4)
Sheets("SGK BİLDİRİM").Cells(Sheets("SGK BİLDİRİM").Cells(Rows.Count, "D").End(3).Row + 1, "D") = Target.Offset(0, 6)
Sheets("SGK BİLDİRİM").Cells(Sheets("SGK BİLDİRİM").Cells(Rows.Count, "E").End(3).Row + 1, "E") = Target.Offset(0, 19)
Sheets("SGK BİLDİRİM").Cells(Sheets("SGK BİLDİRİM").Cells(Rows.Count, "F").End(3).Row + 1, "F") = Target.Offset(0, 9)
Sheets("SGK BİLDİRİM").Cells(Sheets("SGK BİLDİRİM").Cells(Rows.Count, "G").End(3).Row + 1, "G") = Target.Offset(0, 10)
Sheets("SGK BİLDİRİM").Cells(Sheets("SGK BİLDİRİM").Cells(Rows.Count, "H").End(3).Row + 1, "H") = Target.Offset(0, 11)
Sheets("SGK BİLDİRİM").Cells(Sheets("SGK BİLDİRİM").Cells(Rows.Count, "I").End(3).Row + 1, "I") = Format(Target.Offset(0, 12), "#,##0.00")
Sheets("SGK BİLDİRİM").Cells(Sheets("SGK BİLDİRİM").Cells(Rows.Count, "J").End(3).Row + 1, "J") = Format(Target.Offset(0, 15), "#,##0.00")
Sheets("SGK BİLDİRİM").Cells(Sheets("SGK BİLDİRİM").Cells(Rows.Count, "K").End(3).Row + 1, "K") = Target.Offset(0, 16)
Sheets("SGK BİLDİRİM").Cells(Sheets("SGK BİLDİRİM").Cells(Rows.Count, "L").End(3).Row + 1, "L") = Target.Offset(0, 17)
Sheets("SGK BİLDİRİM").Cells(Sheets("SGK BİLDİRİM").Cells(Rows.Count, "M").End(3).Row + 1, "M") = Target.Offset(0, 18)

Sheets("TEMİNAT").Range("B4").Value = Format(Target.Offset(0, 12).Value, "#,##0.00")
End If
End If
End Sub
Yukarıdaki kod ile aktarma yapıyorum. Ancak B ve M sütunlarına mükerrer aktarma yapıldığı zaman "Mükerrer Kayıt" uyarısı verecek sil komutu ile de o satırı komple silecek bir kod entegre edemedim.

Rica etsem yardımcı olur musunuz?

Teşekkür eder, saygılarımı sunarım.
 
Moderatör tarafında düzenlendi:

Murat OSMA

Yönetici
Site Yöneticisi
Katılım
25 May 2018
Mesajlar
1,534
En iyi yanıt
13
Puanları
113
Konum
İstanbul
Web sitesi
excelarsivi.com
Ad Soyad
Murat OSMA
Office Vers.
Office 365 TR+EN
Merhaba,
Eğer "Mükerrer Kayıt" uyarısını illâki ekranda görmeniz gerekmiyorsa, verileri aktardıktan sonra Yinelenen Verileri Kaldır deseniz daha kolay bir işlem olur.
 

istiklal

Yeni Üye
Katılım
11 Nis 2019
Mesajlar
34
En iyi yanıt
0
Puanları
8
Yaş
49
Konum
Malatya
Ad Soyad
İlhan Yüksel
Office Vers.
Microsoft Office 2016 TR
Üstadım
Verileri aktardıktan sonrası için şu an yukarıda belirttiğiniz şekilde yapıyorum. Ama bayağı sıkıntı yaratıyor. Eğer mümkünse ve zamanınız var ise aktarırken mükerrer kontrolü için yardımcı olabilir misiniz?
 

Murat OSMA

Yönetici
Site Yöneticisi
Katılım
25 May 2018
Mesajlar
1,534
En iyi yanıt
13
Puanları
113
Konum
İstanbul
Web sitesi
excelarsivi.com
Ad Soyad
Murat OSMA
Office Vers.
Office 365 TR+EN
Dosyanızı gönderirseniz üzerinde çözümü hazırlayıp gönderebilirim.
 

istiklal

Yeni Üye
Katılım
11 Nis 2019
Mesajlar
34
En iyi yanıt
0
Puanları
8
Yaş
49
Konum
Malatya
Ad Soyad
İlhan Yüksel
Office Vers.
Microsoft Office 2016 TR
Üstad dosya ekte
Yardımınızı esirgemediğiniz için teşekkür ederim. Sağ olasın
 

Ekli dosyalar

  • soru.xlsm
    56.2 KB · Görüntüleme: 16

Murat OSMA

Yönetici
Site Yöneticisi
Katılım
25 May 2018
Mesajlar
1,534
En iyi yanıt
13
Puanları
113
Konum
İstanbul
Web sitesi
excelarsivi.com
Ad Soyad
Murat OSMA
Office Vers.
Office 365 TR+EN
Kodlarınızı bu şekilde revize edin..
Ayrıca verdiğim kodları bir inceleyin, ilerisi için size yardımcı olacaktır.
PHP:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim son As Long, osma As Range, sgk As Worksheet
    Set sgk = Worksheets("SGK BİLDİRİM")
    If Not Intersect(Target, Range("A3:A65536")) Is Nothing Then
        Cancel = True
        Set osma = sgk.Columns(2).Find(Target.Offset(0, 2).Value, , , 1)
        If Not osma Is Nothing Then
            If Cells(Target.Row, "S").Value = sgk.Cells(osma.Row, "M").Value Then
                MsgBox "Bu daha önce kayıt edilmiş.", vbCritical, "UYARI"
                Exit Sub
            End If
        Else
            Range("A3:A65536").Replace "ü", "" 'Araya Ekleyin
            With Target
                .Font.Name = "Wingdings"
                .Font.Size = 12
                .HorizontalAlignment = xlCenter
            End With
            If Target.Value = "ü" Then
                Cells(Target.Row, "S") = ""
                Target.Value = ""
                Sheets("Sözleşme").Range("a1") = ""
            Else
                Cells(Target.Row, "S") = Format(Now, "dd.mm.yyyy") ' dddd hh:mm")
                Target.Value = "ü"
                son = sgk.Cells(Rows.Count, "A").End(3).Row + 1
                Sheets("KAYIT").Range("A1") = Target.Next.Value
                With sgk
                    .Cells(son, "B") = Target.Offset(0, 2)
                    .Cells(son, "C") = Target.Offset(0, 4)
                    .Cells(son, "D") = Target.Offset(0, 6)
                    .Cells(son, "E") = Target.Offset(0, 19)
                    .Cells(son, "F") = Target.Offset(0, 9)
                    .Cells(son, "G") = Target.Offset(0, 10)
                    .Cells(son, "H") = Target.Offset(0, 11)
                    .Cells(son, "I") = Format(Target.Offset(0, 12), "#,##0.00")
                    .Cells(son, "J") = Format(Target.Offset(0, 15), "#,##0.00")
                    .Cells(son, "K") = Target.Offset(0, 16)
                    .Cells(son, "L") = Target.Offset(0, 17)
                    .Cells(son, "M") = Target.Offset(0, 18)
                End With
            End If
        End If
    End If
    Set sgk = Nothing: Set osma = Nothing: son = Empty
End Sub
 

istiklal

Yeni Üye
Katılım
11 Nis 2019
Mesajlar
34
En iyi yanıt
0
Puanları
8
Yaş
49
Konum
Malatya
Ad Soyad
İlhan Yüksel
Office Vers.
Microsoft Office 2016 TR
Gösterdiğiniz ilgi, alaka ve yardımınıza çok çok teşekkür ederim.
Allah razı olsun
 
Durum
Üzgünüz bu konu cevaplar için kapatılmıştır...
Üst Alt