- Katılım
- 15 Mart 2005
- Mesajlar
- 42,246
- Excel Vers. ve Dili
- Microsoft 365 Tr-En 64 Bit
Selamlar,
Aşağıdaki kodlara C,D ve E sütunlarına göre mükerrer kayıt kontrolü eklemek istiyorum forumda araştırdım Sn. ALPEN'e ait aşağıdaki kodları buldum fakat kendi kodlarımda nereye ekleyeceğimi beceremedim.
Sn. ALPEN'e ait kodlar;
Private Sub CommandButton1_Click()
Dim x As Boolean
x = False
For i = 1 To Sheets("sheet2").Cells(65536, 1).End(xlUp).Row
If TextBox1.Text = Sheets("sheet2").Cells(i, 1) And TextBox2.Text = Sheets("sheet2").Cells(i, 2) Then
x = True
MsgBox ("Mükerrer kayıt")
Exit For
End If
Next i
If x = False Then
Sheets("sheet2").Cells(i, 1) = TextBox1
Sheets("sheet2").Cells(i, 2) = TextBox2
End If
End Sub
Kendi kodlarım;
Private Sub CommandButton2_Click()
Application.ScreenUpdating = False
For X = 1 To 5
If Controls("TextBox" & X).Value = Empty Then
MsgBox ("Kayıt işlemi için gerekli tüm bölümlere veri girmelisiniz." _
& Chr(10) & "Lütfen boş bıraktığınız bölümleri doldurunuz."), vbExclamation, "Dikkat !"
Controls("TextBox" & X).SetFocus
Exit Sub
End If
Next
If ComboBox1.Value = Empty Then
MsgBox ("Kayıt işlemi için gerekli tüm bölümlere veri girmelisiniz." _
& Chr(10) & "Lütfen boş bıraktığınız bölümleri doldurunuz."), vbExclamation, "Dikkat !"
ComboBox1.SetFocus
Exit Sub
End If
If WorksheetFunction.CountA(Sheets("S1").[B2:B2501]) = 2500 Then
MsgBox ("En fazla 2.500 adet kayıt girebilirsiniz."), vbExclamation, "Dikkat !"
Call Formu_Temizle
Call UserForm_Initialize
Exit Sub
End If
Dim Tarih1, Tarih2, Tarih3 As Date
On Error Resume Next
Tarih1 = CDate((TextBox1 & "." & TextBox2 & "." & TextBox3))
Tarih2 = CDate(Sheets("S2").Range("B7"))
Tarih3 = CDate(Sheets("S2").Range("C7"))
If Tarih1 < Tarih2 Or Tarih1 > Tarih3 Then
MsgBox "Girdiğiniz tarih çalışma döneminizin dışında lütfen kontrol ediniz.", vbExclamation, "Dikkat !"
Call Formu_Temizle
Call UserForm_Initialize
Exit Sub
End If
If (CDbl(TextBox5.Value) + CDbl(Sheets("S3").Range("E10").Value)) > CDbl(Sheets("S3").Range("E7").Value) Then
MsgBox "Girmek istediğiniz belge ile Kümülatif Vergi Matrahınızı aşıyorsunuz." _
& Chr(10) & "Lütfen girdiğiniz tutarı kontrol ediniz.", vbExclamation, "Dikkat !"
Call Formu_Temizle
Call UserForm_Initialize
Exit Sub
End If
Sheets("S1").Select
Range("B2").Select
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Select
Loop
If Range("B2").Value = Empty Then
Range("B2").Value = 1
Range("B2").Select
Else
ActiveCell.Value = ActiveCell.Offset(-1, 0).Value + 1
End If
ActiveCell.Offset(0, 1) = CDate((TextBox1.Value) & "." & (TextBox2.Value) & "." & (TextBox3.Value))
ActiveCell.Offset(0, 2) = TextBox4.Text
ActiveCell.Offset(0, 3) = ComboBox1.Text
ActiveCell.Offset(0, 4) = TextBox5.Value * 1
Range("C1:F2501").Sort Key1:=Range("C2"), Key1:=Range("D2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
Range("B2").Select
Call Formu_Temizle
Call UserForm_Initialize
Application.ScreenUpdating = True
End Sub
Aşağıdaki kodlara C,D ve E sütunlarına göre mükerrer kayıt kontrolü eklemek istiyorum forumda araştırdım Sn. ALPEN'e ait aşağıdaki kodları buldum fakat kendi kodlarımda nereye ekleyeceğimi beceremedim.
Sn. ALPEN'e ait kodlar;
Private Sub CommandButton1_Click()
Dim x As Boolean
x = False
For i = 1 To Sheets("sheet2").Cells(65536, 1).End(xlUp).Row
If TextBox1.Text = Sheets("sheet2").Cells(i, 1) And TextBox2.Text = Sheets("sheet2").Cells(i, 2) Then
x = True
MsgBox ("Mükerrer kayıt")
Exit For
End If
Next i
If x = False Then
Sheets("sheet2").Cells(i, 1) = TextBox1
Sheets("sheet2").Cells(i, 2) = TextBox2
End If
End Sub
Kendi kodlarım;
Private Sub CommandButton2_Click()
Application.ScreenUpdating = False
For X = 1 To 5
If Controls("TextBox" & X).Value = Empty Then
MsgBox ("Kayıt işlemi için gerekli tüm bölümlere veri girmelisiniz." _
& Chr(10) & "Lütfen boş bıraktığınız bölümleri doldurunuz."), vbExclamation, "Dikkat !"
Controls("TextBox" & X).SetFocus
Exit Sub
End If
Next
If ComboBox1.Value = Empty Then
MsgBox ("Kayıt işlemi için gerekli tüm bölümlere veri girmelisiniz." _
& Chr(10) & "Lütfen boş bıraktığınız bölümleri doldurunuz."), vbExclamation, "Dikkat !"
ComboBox1.SetFocus
Exit Sub
End If
If WorksheetFunction.CountA(Sheets("S1").[B2:B2501]) = 2500 Then
MsgBox ("En fazla 2.500 adet kayıt girebilirsiniz."), vbExclamation, "Dikkat !"
Call Formu_Temizle
Call UserForm_Initialize
Exit Sub
End If
Dim Tarih1, Tarih2, Tarih3 As Date
On Error Resume Next
Tarih1 = CDate((TextBox1 & "." & TextBox2 & "." & TextBox3))
Tarih2 = CDate(Sheets("S2").Range("B7"))
Tarih3 = CDate(Sheets("S2").Range("C7"))
If Tarih1 < Tarih2 Or Tarih1 > Tarih3 Then
MsgBox "Girdiğiniz tarih çalışma döneminizin dışında lütfen kontrol ediniz.", vbExclamation, "Dikkat !"
Call Formu_Temizle
Call UserForm_Initialize
Exit Sub
End If
If (CDbl(TextBox5.Value) + CDbl(Sheets("S3").Range("E10").Value)) > CDbl(Sheets("S3").Range("E7").Value) Then
MsgBox "Girmek istediğiniz belge ile Kümülatif Vergi Matrahınızı aşıyorsunuz." _
& Chr(10) & "Lütfen girdiğiniz tutarı kontrol ediniz.", vbExclamation, "Dikkat !"
Call Formu_Temizle
Call UserForm_Initialize
Exit Sub
End If
Sheets("S1").Select
Range("B2").Select
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Select
Loop
If Range("B2").Value = Empty Then
Range("B2").Value = 1
Range("B2").Select
Else
ActiveCell.Value = ActiveCell.Offset(-1, 0).Value + 1
End If
ActiveCell.Offset(0, 1) = CDate((TextBox1.Value) & "." & (TextBox2.Value) & "." & (TextBox3.Value))
ActiveCell.Offset(0, 2) = TextBox4.Text
ActiveCell.Offset(0, 3) = ComboBox1.Text
ActiveCell.Offset(0, 4) = TextBox5.Value * 1
Range("C1:F2501").Sort Key1:=Range("C2"), Key1:=Range("D2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
Range("B2").Select
Call Formu_Temizle
Call UserForm_Initialize
Application.ScreenUpdating = True
End Sub