VBA koşullandırma ve kayıt kontrolü

[Tornael]

Selam değerli üstadlarım ve saygı değer ilgililerim,

Ekte bir kaç sorum olacak ilgilenirseniz beni çok mutlu edersiniz.
Bu excel çektiğim bir raporun küçük bir kısmıdır. Mümkünse VBA üzerinden cevaplarsanız beni dahada mutlu edersiniz. Çünkü bu raporda kodlara ayıracak yerim oldukça kısıtlı.

Şimdiden konuya iştigal eden herkese teşekkür ederim.:yardim:

 

[asi_kral]

Merhaba
Sayfanın kod bölümüne kopyalayın ve deneyin.
C2 hücresine veri girildiği anda tetiklenir ve istediğiniz işlemleri yapar.

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim SYF As Worksheet, STR As Long
Application.EnableEvents = False
If Intersect(Target, Range("C2")) Is Nothing Then _
Application.EnableEvents = True: Exit Sub
Target.Interior.ColorIndex = xlNone
If WorksheetFunction.IsText(Target) = True Then
MsgBox "Yanlış Form Girdiniz", vbCritical
Application.EnableEvents = True
End If
If Len(Target) > 10 Then
MsgBox "Yanlış Form Girdiniz", vbCritical
Application.EnableEvents = True
End If
If WorksheetFunction.CountIf(Range("A:A"), Target) > 0 Then
Target.Interior.Color = vbYellow
Application.EnableEvents = True
Else
Set SYF = Sheets("Yeni kayıt")
STR = SYF.Range("A" & Rows.Count).End(xlUp).Row + 1
SYF.Range("A" & STR) = Target
Application.EnableEvents = True
End If
Application.EnableEvents = True
End Sub

Not : Dosyanızı kaydederken Makro içerebilen dosya şeklinde yapınız. ( .xlsm uzantılı )

 

[Tornael]

Teşekkürler

Selam sayın asi_kral_1967,

İlgili konu ile ilgilendiğiniz bir kez daha teşekkür ediyorum.
İstediğim tüm şartlar yerine geldi.

Ama benim bir kaç maruzatım daha olucak;
• "C2" ye girilen formu "A" kolonunda bulur ise bulduğu hücreyi boyaması "C2"yi değil (Ben ilk mesajımda belirtmeyi unutmuşum :frown,
• "Yanlış form girdiniz" uyarısı geldiğinde "Yeni kayıt" sayfasına kaydetmemesi.

Tekrar teşekkür ederim.:bravo:

 

[merakli_72]

selam,
isteklerinizi için sayın asi_kral_1967'nin kodlarının revize edilmiş hali

Private Sub Worksheet_Change(ByVal Target As Range)
Dim SYF As Worksheet, STR, kAcinci As Long


If Intersect(Target, Range("C2")) Is Nothing Then

Exit Sub
End If

Target.Interior.ColorIndex = xlNone
If WorksheetFunction.IsText(Target) = True Or _
Len(Target) <> 10 Then
MsgBox "Yanlış Form Girdiniz", vbCritical

Exit Sub
End If

If WorksheetFunction.CountIf(Range("A:A"), Target) > 0 Then

kAcinci = Evaluate("=MATCH(C2,A:A,0)")
Cells(kAcinci, "A").Interior.Color = vbYellow

Else

Set SYF = Sheets("Yeni kayıt")
STR = SYF.Range("A" & Rows.Count).End(xlUp).Row + 1
SYF.Range("A" & STR) = Target

End If

End Sub

 

[Tornael]

Tebrikler

İşte tam istediğim gibi ilgileriniz için çok sağolun üstadlarım.

Teşekkürler:mutlu: