• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

aynı sayfada iki farklı Worksheet_Change kodu çalıştırmak

  • Konbuyu başlatan Konbuyu başlatan Salihd46
  • Başlangıç tarihi Başlangıç tarihi
S

Salihd46

Katılım
4 Mart 2020
Mesajlar
40
Excel Vers. ve Dili
OFFİCE 2016, VBA
İyi günler arkadaşlar,
iki farklı If kodum var çalışan, bunları aynı sayfaya eklemeye çalıştım, birleştirmeye de çalıştım içinden çıkamadım yardımcı olursanız sevinirim.
Birincisi:

Private Sub Worksheet_Change(ByVal Target As Range)

On Error Resume Next
If Intersect(Target, Range("G13:G13")) Is Nothing Or Target.Row < 5 Or Target.Value = vbEmpty Then Exit Sub

If Len(Target) <> 11 Then
MsgBox "TC Kimlik numarası 11 Rakamdan oluşmalıdır.", vbCritical, "Hatalı !" 'X
Exit Sub
End If

Dim mod1 As Integer, mod2 As Integer, TC1 As Integer, TC2 As Integer, TC3 As Integer, TC4 As Integer, TC5 As Integer, TC6 As Integer, TC7 As Integer, TC8 As Integer, TC9 As Integer, TC10 As Integer, TC11 As Integer
TC1 = Mid(Target, 1, 1)
TC2 = Mid(Target, 2, 1)
TC3 = Mid(Target, 3, 1)
TC4 = Mid(Target, 4, 1)
TC5 = Mid(Target, 5, 1)
TC6 = Mid(Target, 6, 1)
TC7 = Mid(Target, 7, 1)
TC8 = Mid(Target, 8, 1)
TC9 = Mid(Target, 9, 1)
TC10 = Mid(Target, 10, 1)
TC11 = Mid(Target, 11, 1)

mod1 = ((((TC1 + TC3 + TC5 + TC7 + TC9) * 7) - (TC2 + TC4 + TC6 + TC8)) Mod 10)
mod2 = ((TC1 + TC2 + TC3 + TC4 + TC5 + TC6 + TC7 + TC8 + TC9 + TC10) Mod 10)

If mod1 = TC10 And mod2 = TC11 Then
' MsgBox Target & " Geçerli TC kimlik numarası", vbInformation, "Bilgilendirme !"
Else
MsgBox Target & " Geçersiz TC kimlik numarası", vbExclamation, "Dikkat !"
End If
End Sub

İklincisi:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("C13:C13")) Is Nothing Then Exit Sub
Target.Cells(1, 1).Value = Format(Target.Cells(1, 1).Value, "TR440000000000")
Exit Sub
End Sub
 
Aşağıdaki gibi deneyin:

PHP: 
Private Sub Worksheet_Change(ByVal Target As Range)

On Error Resume Next
If Intersect(Target, Range("G13:G13")) Is Nothing Or Target.Row < 5 Or Target.Value = vbEmpty Then GoTo 10

If Len(Target) <> 11 Then
MsgBox "TC Kimlik numarası 11 Rakamdan oluşmalıdır.", vbCritical, "Hatalı !" 'X
Exit Sub
End If

Dim mod1 As Integer, mod2 As Integer, TC1 As Integer, TC2 As Integer, TC3 As Integer, TC4 As Integer, TC5 As Integer, TC6 As Integer, TC7 As Integer, TC8 As Integer, TC9 As Integer, TC10 As Integer, TC11 As Integer
TC1 = Mid(Target, 1, 1)
TC2 = Mid(Target, 2, 1)
TC3 = Mid(Target, 3, 1)
TC4 = Mid(Target, 4, 1)
TC5 = Mid(Target, 5, 1)
TC6 = Mid(Target, 6, 1)
TC7 = Mid(Target, 7, 1)
TC8 = Mid(Target, 8, 1)
TC9 = Mid(Target, 9, 1)
TC10 = Mid(Target, 10, 1)
TC11 = Mid(Target, 11, 1)

mod1 = ((((TC1 + TC3 + TC5 + TC7 + TC9) * 7) - (TC2 + TC4 + TC6 + TC8)) Mod 10)
mod2 = ((TC1 + TC2 + TC3 + TC4 + TC5 + TC6 + TC7 + TC8 + TC9 + TC10) Mod 10)

If mod1 = TC10 And mod2 = TC11 Then
' MsgBox Target & " Geçerli TC kimlik numarası", vbInformation, "Bilgilendirme !"
Else
MsgBox Target & " Geçersiz TC kimlik numarası", vbExclamation, "Dikkat !"
End If
10:
If Intersect(Target, Range("C13:C13")) Is Nothing Then Exit Sub
Target.Cells(1, 1).Value = Format(Target.Cells(1, 1).Value, "TR440000000000")
Exit Sub 
End Sub
 
Kodlardan anladığım Malatya'da Tarım İl/İlçe Müdürlüğünde çalışıyorsunuz ve küpe numaralarıyla ilgili bir işlem yapıyorsunuz. Doğru mudur? Öyleyse eğer tam olarak nasıl bir dosya hazırladığınızı öğrenebilir miyim?
 
Evet aynen Yusuf bey, destek dilekçesi hazırlama çalışması ve bizim için de 10 a yakın dilekçe formatını otomatik doldurma çalışması yaptım sona geldim. zaten vatandaşın tüm bilgileri bizde var tekrar elle neden yazalım düşüncesi ve en önemlisi destek zamanı binlerce dilekçe elle yazılıyor, kalem kağıt dilekçe yazamayan amcalar oluyor, kendi işimizi bırakıp dilekçesini yazıyoruz. Şimdi sadece tc veya işletme numarası ile tüm bilgileri otomatik geliyor ve vatandaşın sadece imza atması kalıyor.
Ben de yeni girdim bu işe ve sevdim devam ettirip daha güzel çalışmalar yapmayı arzu ediyorum.
Merak, ilmin hocasıdır
İhtiyaç, medeniyetin üstadıdır.
 
Gayretinizi tebrik ve takdir ediyorum. İşinizi kolaylaştırmak açısından Amasya İl Tarım Müdürlüğünde bu yönde çalışma yapan arkadaşlar var ve İl Müdürlüğünün internet sitesinde de bu tarz programları yayınlıyorlar. O dosyaları incelemenizi öneririm. Bizim ilçede destek başvurularının büyük kısmını Birlikler hallettiği için bu tarz programlara fazla ihtiyaç olmuyor.

Kendi dairemizde kullanmak üzere hazırladığım kontrol görevi tablosu ve düşen küpe talep tablosunu paylaşıyorum. Belki işinize yarar, belki geliştirilmesine katkı yaparsınız.

Not: Bu arada kullanıcı adımdan da anlaşılacağı üzere Malatyalıyım :)
 

Ekli dosyalar

Teşekkür ederim, ekler için de sağolun, altın üye başvurusu yaptım az önce, onaylansın, dosyaları indireyim inş.
Ben de Elbistan'lıyım, Malatya sayılır, yakın zaten. Tanıştığımıza memnun oldum.
Tekrar teşekkürler
İyi çalışmalar
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst