VBA formül birleştirme

sinnernekolens

Altın Üye
Katılım
23 Temmuz 2009
Mesajlar
310
Excel Vers. ve Dili
Ofis 2019 - Türkçe 64bit
Altın Üyelik Bitiş Tarihi
02-09-2027
iyi günler,

Aşağıdaki iki formülü nasil verilmli kullanabilirim.

veriyi kaydet butonuna bastığımda Gemi sayfasında aynı veri varsa uyarı versin kaydetmesin.

aşağıdaki formül uyarıyı veriyor ama iptal etmesi gerekirken yinede kaydediyor.

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("A2:A5000")) Is Nothing Then Exit Sub
If WorksheetFunction.CountIf(Range("A2:A5000"), Target) > 1 Then
MsgBox "Hatalı Giriş Bu Girdiğiniz Değer Var", vbCritical, "sinnernekolens"
End If
End Sub

Private Sub CommandButton5_Click()
Son_Dolu_Satir = Sheets("GEMI").Range("A65536").End(xlUp).Row
Bos_Satir = Son_Dolu_Satir + 1
Sheets("GEMI").Range("A" & Bos_Satir).Value = _
Application.WorksheetFunction.Max(Sheets("GEMI").Range("A:A")) + 1
Sheets("GEMI").Range("A" & Bos_Satir).Value = Sheets("FDA").Range("C5")
Sheets("GEMI").Range("B" & Bos_Satir).Value = Sheets("FDA").Range("C6")
Sheets("GEMI").Range("C" & Bos_Satir).Value = Sheets("FDA").Range("C7")
Sheets("GEMI").Range("D" & Bos_Satir).Value = Sheets("FDA").Range("C8")

MsgBox "Kaydedilmiştir."
End Sub
 

Ekli dosyalar

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,248
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
İlgili yeri aşağıdaki gibi deneyiniz.:cool:
Kod:
If WorksheetFunction.CountIf(Range("A2:A5000"), Target) [B][COLOR="Red"]>=[/COLOR][/B] 1 Then
MsgBox "Hatalı Giriş Bu Girdiğiniz Değer Var", vbCritical, "sinnernekolens"
[B][COLOR="red"]exit sub[/COLOR][/B]
End If
 

sinnernekolens

Altın Üye
Katılım
23 Temmuz 2009
Mesajlar
310
Excel Vers. ve Dili
Ofis 2019 - Türkçe 64bit
Altın Üyelik Bitiş Tarihi
02-09-2027
iyi günler, ilginiz için teşekkür ederim ancak çalıştıramadım. ekli örnekte uygulayabilir misiniz.
 

Ömer BARAN

Uzman
Katılım
8 Mart 2011
Mesajlar
12,997
Excel Vers. ve Dili
Office 2013 ( 32 bit ) TÜRKÇE
Altın Üyelik Bitiş Tarihi
(18.03.2020) - Uzman olduğu için tarih geçersiz oldu.
Merhaba.

► GEMI isimli sayfanın kod bölümünde mevcut olan Worksheet_Change kodlarını silin,

►CommandButton5'e ait kodları da aşağıdaki iki seçeneğe göre karar vererek;
yani ya kırmızı satırı silerek ya da mavi satırları silerek, mevcut kodlarınızla değiştirin.

-- FDA sayfasında sadece C5 hücresindeki değer GEMI sayfası A sütununda var mı şeklindeki kontrol yeterli ise mavi satırları silin.
-- FDA sayfası C5:C8 aralığındaki tüm değerler için GEMI sayfası A:D sütunlarında TAM EŞLEŞME var mı şeklinde kontrol yapmak istiyorsanız aşağıdaki kırmızı satırı silin.
.
Kod:
Private Sub CommandButton5_Click()
[COLOR="Blue"]gson = Sheets("GEMI").Cells(Rows.Count, 1).End(3).Row
varmi = Evaluate("=SUMPRODUCT((GEMI!A2:A" & gson & "=FDA!C5)*(GEMI!B2:B" & gson & "=FDA!C6)*(GEMI!C2:C" & gson & "=FDA!C7)*(GEMI!D2:D" & gson & "=FDA!C8))")
If varmi = 0 Then[/COLOR]
[COLOR="Red"]If WorksheetFunction.CountIf(Sheets("GEMI").[A:A], Sheets("FDA").[C5]) = 0 Then[/COLOR]
    Son_Dolu_Satir = Sheets("GEMI").Range("A65536").End(xlUp).Row
    Bos_Satir = Son_Dolu_Satir + 1
    Sheets("GEMI").Range("A" & Bos_Satir).Value = Sheets("FDA").Range("C5")
    Sheets("GEMI").Range("B" & Bos_Satir).Value = Sheets("FDA").Range("C6")
    Sheets("GEMI").Range("C" & Bos_Satir).Value = Sheets("FDA").Range("C7")
    Sheets("GEMI").Range("D" & Bos_Satir).Value = Sheets("FDA").Range("C8")

    MsgBox "Kaydedilmiştir."
    Sheets("FDA").[C5:C8].ClearContents
Else
    MsgBox "Hatalı Giriş Bu Girdiğiniz Değer Var", vbCritical, "sinnernekolens"
End If
End Sub
 
Üst