mükerrer kayıt

S

sinemomec

Katılım
21 Ocak 2013
Mesajlar
422
Excel Vers. ve Dili
2010
01.01 VAKIF KURULUŞ İŞLEMLERİ
01.02 MÜTEVELLİ HEYET İŞLEMLERİ
01.03 VAKIF ÇALIŞANLARI İŞLEMLERİ
01.04 VAKIF BANKACILIK İŞLEMLERİ
01.06 VAKIF MUHASEBE İŞLEMLERİ
01.07 VAKIF SATINALMA İŞLEMLERİ
01.08 VAKIF TAŞINIR VE TAŞINMAZ MAL İŞLEMLERİ
bu şekilde dosya numaralarım var bunların tekrar aynı kodla ve aynı isimle girilmesini engellemek ve uyarı almak isityorum
Kod: 
Dim wsGELENEVRAK, wsGİDENEVRAK, wsPERSONELÖNTANIM, wsDESİMALDOSYA As Worksheet
Dim sonsatır, sil As Long
Dim konrol As Byte
Private Sub Cmdkaydet_Click()
If Tbdosyakodu.Text = "" Then
MsgBox "DOSYA KODU BOŞ OLAMAZ.", vbInformation, "BİLDİRİ"
Exit Sub
ElseIf Tbdosyaadı.Text = "" Then
MsgBox "DOSYA ADI BOŞ OLAMAZ.", vbInformation, "BİLDİRİ"
Exit Sub
End If
sonsatır = WorksheetFunction.CountA(Worksheets("DESİMALDOSYA").Range("A:A")) + 1
If sonsatır = 2 Then
Worksheets("DESİMALDOSYA").Cells(sonsatır, 1) = 1
Else
Worksheets("DESİMALDOSYA").Cells(sonsatır, 1) = Worksheets("DESİMALDOSYA").Cells(sonsatır - 1, 1) + 1
End If
Worksheets("DESİMALDOSYA").Cells(sonsatır, 2) = Tbdosyakodu.Value
Worksheets("DESİMALDOSYA").Cells(sonsatır, 3) = Tbdosyaadı.Value
MsgBox "VERİ KAYDEDİLDİ.", vbInformation, "BİLDİRİ"
Tbdosyakodu.Value = ""
Tbdosyaadı.Value = ""
listele
End Sub
Private Sub CmdSil_Click()
sor = MsgBox("SEÇİLEN KAYIT SİLİNECEK.", vbYesNoCancel + vbInformation, "BİLDİRİ")
If sor = vbNo Then Exit Sub
If sor = vbCancel Then Exit Sub
For a = 0 To lstdesimaldosya.ListCount - 1
If lstdesimaldosya.Selected(a) Then
ara = lstdesimaldosya.List(a, 0)
Sheets("DESİMALDOSYA").Range("A:A").Find(what:=ara, lookat:=xlWhole).EntireRow.Delete
End If
Next
End Sub
Private Sub Tbdosyaadı_Change()
If Tbdosyaadı = "" Then Exit Sub
deg = Mid(Tbdosyaadı.Value, Len(Tbdosyaadı.Value), 1)
If IsNumeric(deg) = True Then
MsgBox "SADECE HARF GİRİNİZ !", vbInformation, "BİLDİRİ"
Tbdosyaadı = Mid(Tbdosyaadı.Value, 1, Len(Tbdosyaadı.Value) - 1)
Tbdosyaadı.SetFocus
End If
Tbdosyaadı = Replace(Tbdosyaadı, "i", "İ")
Tbdosyaadı = Replace(Tbdosyaadı, "ı", "I")
Tbdosyaadı = StrConv(Tbdosyaadı, vbUpperCase)
End Sub
Private Sub UserForm_Initialize()
listele
End Sub
Sub listele()
Dim x As Long
For x = 1 To 1000000
If Range("DESİMALDOSYA!A" & x).Value <> "" Then
x = x + 1
Else
Exit For
End If
Next
lstdesimaldosya.ColumnCount = 3
lstdesimaldosya.RowSource = "DESİMALDOSYA!$A2:C$" & x
lstdesimaldosya.ColumnWidths = "50;250;400"
End Sub
 
Greenblacksea53

Greenblacksea53

Altın Üye
Katılım
5 Ocak 2019
Mesajlar
550
Excel Vers. ve Dili
Ofis 365 Tr
Altın Üyelik Bitiş Tarihi
05-01-2025
C++: 
Dim wsGELENEVRAK, wsGİDENEVRAK, wsPERSONELÖNTANIM, wsDESİMALDOSYA As Worksheet
Dim sonsatır, sil As Long
Dim konrol As Byte
Private Sub Cmdkaydet_Click()
If Tbdosyakodu.Text = "" Then
MsgBox "DOSYA KODU BOŞ OLAMAZ.", vbInformation, "BİLDİRİ"
Exit Sub
ElseIf Tbdosyaadı.Text = "" Then
MsgBox "DOSYA ADI BOŞ OLAMAZ.", vbInformation, "BİLDİRİ"
Exit Sub
End If
sonsatır = WorksheetFunction.CountA(Worksheets("DESİMALDOSYA").Range("A:A")) + 1
If sonsatır = 2 Then
Worksheets("DESİMALDOSYA").Cells(sonsatır, 1) = 1
Else
Worksheets("DESİMALDOSYA").Cells(sonsatır, 1) = Worksheets("DESİMALDOSYA").Cells(sonsatır - 1, 1) + 1
End If


Set syf = Sheets("DESİMALDOSYA")

dsy1 = Tbdosyakodu.Value
dsy2 = Tbdosyaadı.Value

dsy1varmi = WorksheetFunction.CountIf(syf.Range("a" & sonsatır), dsy1)
dsy2varmi= WorksheetFunction.CountIf(syf.Range("a" & sonsatır), dsy2)
If dsy1varmi and dsy2varmi > 0 Then
MsgBox "Var", vbInformation, "BİLDİRİ"
Exit Sub
else

Worksheets("DESİMALDOSYA").Cells(sonsatır, 2) = Tbdosyakodu.Value
Worksheets("DESİMALDOSYA").Cells(sonsatır, 3) = Tbdosyaadı.Value
MsgBox "VERİ KAYDEDİLDİ.", vbInformation, "BİLDİRİ"
Tbdosyakodu.Value = ""
Tbdosyaadı.Value = ""
listele

end if

End Sub
Private Sub CmdSil_Click()
sor = MsgBox("SEÇİLEN KAYIT SİLİNECEK.", vbYesNoCancel + vbInformation, "BİLDİRİ")
If sor = vbNo Then Exit Sub
If sor = vbCancel Then Exit Sub
For a = 0 To lstdesimaldosya.ListCount - 1
If lstdesimaldosya.Selected(a) Then
ara = lstdesimaldosya.List(a, 0)
Sheets("DESİMALDOSYA").Range("A:A").Find(what:=ara, lookat:=xlWhole).EntireRow.Delete
End If
Next
End Sub
Private Sub Tbdosyaadı_Change()
If Tbdosyaadı = "" Then Exit Sub
deg = Mid(Tbdosyaadı.Value, Len(Tbdosyaadı.Value), 1)
If IsNumeric(deg) = True Then
MsgBox "SADECE HARF GİRİNİZ !", vbInformation, "BİLDİRİ"
Tbdosyaadı = Mid(Tbdosyaadı.Value, 1, Len(Tbdosyaadı.Value) - 1)
Tbdosyaadı.SetFocus
End If
Tbdosyaadı = Replace(Tbdosyaadı, "i", "İ")
Tbdosyaadı = Replace(Tbdosyaadı, "ı", "I")
Tbdosyaadı = StrConv(Tbdosyaadı, vbUpperCase)
End Sub
Private Sub UserForm_Initialize()
listele
End Sub
Sub listele()
Dim x As Long
For x = 1 To 1000000
If Range("DESİMALDOSYA!A" & x).Value <> "" Then
x = x + 1
Else
Exit For
End If
Next
lstdesimaldosya.ColumnCount = 3
lstdesimaldosya.RowSource = "DESİMALDOSYA!$A2:C$" & x
lstdesimaldosya.ColumnWidths = "50;250;400"
End Sub
Deenermisin ?
 
Greenblacksea53

Greenblacksea53

Altın Üye
Katılım
5 Ocak 2019
Mesajlar
550
Excel Vers. ve Dili
Ofis 365 Tr
Altın Üyelik Bitiş Tarihi
05-01-2025
C++: 
Dim wsGELENEVRAK, wsGİDENEVRAK, wsPERSONELÖNTANIM, wsDESİMALDOSYA As Worksheet
Dim sonsatır, sil As Long
Dim konrol As Byte
Private Sub Cmdkaydet_Click()
If Tbdosyakodu.Text = "" Then
MsgBox "DOSYA KODU BOŞ OLAMAZ.", vbInformation, "BİLDİRİ"
Exit Sub
ElseIf Tbdosyaadı.Text = "" Then
MsgBox "DOSYA ADI BOŞ OLAMAZ.", vbInformation, "BİLDİRİ"
Exit Sub
End If
sonsatır = WorksheetFunction.CountA(Worksheets("DESİMALDOSYA").Range("A:A")) + 1
If sonsatır = 2 Then
Worksheets("DESİMALDOSYA").Cells(sonsatır, 1) = 1
Else
Worksheets("DESİMALDOSYA").Cells(sonsatır, 1) = Worksheets("DESİMALDOSYA").Cells(sonsatır - 1, 1) + 1
End If

Set syf = Sheets("DESİMALDOSYA")
sonsatır53 = WorksheetFunction.CountA(Worksheets("DESİMALDOSYA").Range("B:B")) + 1
dsy1 = Tbdosyakodu.Value
dsy2 = Tbdosyaadı.Value
dsy1varmi = WorksheetFunction.CountIf(syf.Range("b" & sonsatır53), dsy1)
dsy2varmi = WorksheetFunction.CountIf(syf.Range("c" & sonsatır53), dsy2)
If dsy1varmi > 0 And dsy2varmi > 0 Then
MsgBox "Var", vbInformation, "BİLDİRİ"
Exit Sub
Else

Worksheets("DESİMALDOSYA").Cells(sonsatır, 2) = Tbdosyakodu.Value
Worksheets("DESİMALDOSYA").Cells(sonsatır, 3) = Tbdosyaadı.Value
MsgBox "VERİ KAYDEDİLDİ.", vbInformation, "BİLDİRİ"
Tbdosyakodu.Value = ""
Tbdosyaadı.Value = ""
listele

end if

End Sub
Private Sub CmdSil_Click()
sor = MsgBox("SEÇİLEN KAYIT SİLİNECEK.", vbYesNoCancel + vbInformation, "BİLDİRİ")
If sor = vbNo Then Exit Sub
If sor = vbCancel Then Exit Sub
For a = 0 To lstdesimaldosya.ListCount - 1
If lstdesimaldosya.Selected(a) Then
ara = lstdesimaldosya.List(a, 0)
Sheets("DESİMALDOSYA").Range("A:A").Find(what:=ara, lookat:=xlWhole).EntireRow.Delete
End If
Next
End Sub
Private Sub Tbdosyaadı_Change()
If Tbdosyaadı = "" Then Exit Sub
deg = Mid(Tbdosyaadı.Value, Len(Tbdosyaadı.Value), 1)
If IsNumeric(deg) = True Then
MsgBox "SADECE HARF GİRİNİZ !", vbInformation, "BİLDİRİ"
Tbdosyaadı = Mid(Tbdosyaadı.Value, 1, Len(Tbdosyaadı.Value) - 1)
Tbdosyaadı.SetFocus
End If
Tbdosyaadı = Replace(Tbdosyaadı, "i", "İ")
Tbdosyaadı = Replace(Tbdosyaadı, "ı", "I")
Tbdosyaadı = StrConv(Tbdosyaadı, vbUpperCase)
End Sub
Private Sub UserForm_Initialize()
listele
End Sub
Sub listele()
Dim x As Long
For x = 1 To 1000000
If Range("DESİMALDOSYA!A" & x).Value <> "" Then
x = x + 1
Else
Exit For
End If
Next
lstdesimaldosya.ColumnCount = 3
lstdesimaldosya.RowSource = "DESİMALDOSYA!$A2:C$" & x
lstdesimaldosya.ColumnWidths = "50;250;400"
End Sub
Yada bunu dener misin? Sen 2B ce C sütünuna kaydettiyorsun,
Set syf = Sheets("DESİMALDOSYA")
sonsatır53 = WorksheetFunction.CountA(Worksheets("DESİMALDOSYA").Range("B:B")) + 1
dsy1 = Tbdosyakodu.Value
dsy2 = Tbdosyaadı.Value
dsy1varmi = WorksheetFunction.CountIf(syf.Range("b" & sonsatır53), dsy1)
dsy2varmi = WorksheetFunction.CountIf(syf.Range("c" & sonsatır53), dsy2)
If dsy1varmi > 0 And dsy2varmi > 0 Then
MsgBox "Var", vbInformation, "BİLDİRİ"
Exit Sub
Else
Bu kodlarla b sütünundaki son satırı bulduk, değişkene atadık textbox değerlerini sayfanda b ve c sütunda, var ise mesaj hatası verip uyaracak
 
Greenblacksea53

Greenblacksea53

Altın Üye
Katılım
5 Ocak 2019
Mesajlar
550
Excel Vers. ve Dili
Ofis 365 Tr
Altın Üyelik Bitiş Tarihi
05-01-2025
Bi önceki mesajimdaki editordeki bütün kodları alıp denedin dimi?
 
S

sinemomec

Katılım
21 Ocak 2013
Mesajlar
422
Excel Vers. ve Dili
2010
Set syf = Sheets("DESİMALDOSYA")
sonsatır53 = WorksheetFunction.CountA(Worksheets("DESİMALDOSYA").Range("B:B")) + 1
dsy1 = Tbdosyakodu.Value
dsy2 = Tbdosyaadı.Value
dsy1varmi = WorksheetFunction.CountIf(syf.Range("b" & sonsatır53), dsy1)
dsy2varmi = WorksheetFunction.CountIf(syf.Range("c" & sonsatır53), dsy2)
If dsy1varmi > 0 And dsy2varmi > 0 Then
MsgBox "Var", vbInformation, "BİLDİRİ"
Exit Sub
Else
sadece bu kodumu deneyim nereye yapıştıracam kodu
 
Greenblacksea53

Greenblacksea53

Altın Üye
Katılım
5 Ocak 2019
Mesajlar
550
Excel Vers. ve Dili
Ofis 365 Tr
Altın Üyelik Bitiş Tarihi
05-01-2025
sinemomec' Alıntı:
Set syf = Sheets("DESİMALDOSYA")
sonsatır53 = WorksheetFunction.CountA(Worksheets("DESİMALDOSYA").Range("B:B")) + 1
dsy1 = Tbdosyakodu.Value
dsy2 = Tbdosyaadı.Value
dsy1varmi = WorksheetFunction.CountIf(syf.Range("b" & sonsatır53), dsy1)
dsy2varmi = WorksheetFunction.CountIf(syf.Range("c" & sonsatır53), dsy2)
If dsy1varmi > 0 And dsy2varmi > 0 Then
MsgBox "Var", vbInformation, "BİLDİRİ"
Exit Sub
Else
sadece bu kodumu deneyim nereye yapıştıracam kodu
Genişletmek için tıkla ...
Editordeki kodları kopyalayın burda size açıklama yaptım
 
Greenblacksea53

Greenblacksea53

Altın Üye
Katılım
5 Ocak 2019
Mesajlar
550
Excel Vers. ve Dili
Ofis 365 Tr
Altın Üyelik Bitiş Tarihi
05-01-2025
Greenblacksea53' Alıntı:
C++: 
Dim wsGELENEVRAK, wsGİDENEVRAK, wsPERSONELÖNTANIM, wsDESİMALDOSYA As Worksheet
Dim sonsatır, sil As Long
Dim konrol As Byte
Private Sub Cmdkaydet_Click()
If Tbdosyakodu.Text = "" Then
MsgBox "DOSYA KODU BOŞ OLAMAZ.", vbInformation, "BİLDİRİ"
Exit Sub
ElseIf Tbdosyaadı.Text = "" Then
MsgBox "DOSYA ADI BOŞ OLAMAZ.", vbInformation, "BİLDİRİ"
Exit Sub
End If
sonsatır = WorksheetFunction.CountA(Worksheets("DESİMALDOSYA").Range("A:A")) + 1
If sonsatır = 2 Then
Worksheets("DESİMALDOSYA").Cells(sonsatır, 1) = 1
Else
Worksheets("DESİMALDOSYA").Cells(sonsatır, 1) = Worksheets("DESİMALDOSYA").Cells(sonsatır - 1, 1) + 1
End If

Set syf = Sheets("DESİMALDOSYA")
sonsatır53 = WorksheetFunction.CountA(Worksheets("DESİMALDOSYA").Range("B:B")) + 1
dsy1 = Tbdosyakodu.Value
dsy2 = Tbdosyaadı.Value
dsy1varmi = WorksheetFunction.CountIf(syf.Range("b" & sonsatır53), dsy1)
dsy2varmi = WorksheetFunction.CountIf(syf.Range("c" & sonsatır53), dsy2)
If dsy1varmi > 0 And dsy2varmi > 0 Then
MsgBox "Var", vbInformation, "BİLDİRİ"
Exit Sub
Else

Worksheets("DESİMALDOSYA").Cells(sonsatır, 2) = Tbdosyakodu.Value
Worksheets("DESİMALDOSYA").Cells(sonsatır, 3) = Tbdosyaadı.Value
MsgBox "VERİ KAYDEDİLDİ.", vbInformation, "BİLDİRİ"
Tbdosyakodu.Value = ""
Tbdosyaadı.Value = ""
listele

end if

End Sub
Private Sub CmdSil_Click()
sor = MsgBox("SEÇİLEN KAYIT SİLİNECEK.", vbYesNoCancel + vbInformation, "BİLDİRİ")
If sor = vbNo Then Exit Sub
If sor = vbCancel Then Exit Sub
For a = 0 To lstdesimaldosya.ListCount - 1
If lstdesimaldosya.Selected(a) Then
ara = lstdesimaldosya.List(a, 0)
Sheets("DESİMALDOSYA").Range("A:A").Find(what:=ara, lookat:=xlWhole).EntireRow.Delete
End If
Next
End Sub
Private Sub Tbdosyaadı_Change()
If Tbdosyaadı = "" Then Exit Sub
deg = Mid(Tbdosyaadı.Value, Len(Tbdosyaadı.Value), 1)
If IsNumeric(deg) = True Then
MsgBox "SADECE HARF GİRİNİZ !", vbInformation, "BİLDİRİ"
Tbdosyaadı = Mid(Tbdosyaadı.Value, 1, Len(Tbdosyaadı.Value) - 1)
Tbdosyaadı.SetFocus
End If
Tbdosyaadı = Replace(Tbdosyaadı, "i", "İ")
Tbdosyaadı = Replace(Tbdosyaadı, "ı", "I")
Tbdosyaadı = StrConv(Tbdosyaadı, vbUpperCase)
End Sub
Private Sub UserForm_Initialize()
listele
End Sub
Sub listele()
Dim x As Long
For x = 1 To 1000000
If Range("DESİMALDOSYA!A" & x).Value <> "" Then
x = x + 1
Else
Exit For
End If
Next
lstdesimaldosya.ColumnCount = 3
lstdesimaldosya.RowSource = "DESİMALDOSYA!$A2:C$" & x
lstdesimaldosya.ColumnWidths = "50;250;400"
End Sub
Genişletmek için tıkla ...
Bunu denemen lazım kaydet butonuna
 
Greenblacksea53

Greenblacksea53

Altın Üye
Katılım
5 Ocak 2019
Mesajlar
550
Excel Vers. ve Dili
Ofis 365 Tr
Altın Üyelik Bitiş Tarihi
05-01-2025
Telefondan yazmak zormuş
 
S

sinemomec

Katılım
21 Ocak 2013
Mesajlar
422
Excel Vers. ve Dili
2010
hata veriyor
Kod: 
Private Sub Cmdkaydet_Click()
If Tbdosyakodu.Text = "" Then
MsgBox "DOSYA KODU BOŞ OLAMAZ.", vbInformation, "BİLDİRİ"
Exit Sub
ElseIf Tbdosyaadı.Text = "" Then
MsgBox "DOSYA ADI BOŞ OLAMAZ.", vbInformation, "BİLDİRİ"
Exit Sub
End If
sonsatır = WorksheetFunction.CountA(Worksheets("DESİMALDOSYA").Range("A:A")) + 1
If sonsatır = 2 Then
Worksheets("DESİMALDOSYA").Cells(sonsatır, 1) = 1
Else
Worksheets("DESİMALDOSYA").Cells(sonsatır, 1) = Worksheets("DESİMALDOSYA").Cells(sonsatır - 1, 1) + 1
End If



Set syf = Sheets("DESİMALDOSYA")
sonsatır53 = WorksheetFunction.CountA(Worksheets("DESİMALDOSYA").Range("B:B")) + 1
dsy1 = Tbdosyakodu.Value
dsy2 = Tbdosyaadı.Value
dsy1varmi = WorksheetFunction.CountIf(syf.Range("b" & sonsatır53), dsy1)
dsy2varmi = WorksheetFunction.CountIf(syf.Range("c" & sonsatır53), dsy2)
If dsy1varmi > 0 And dsy2varmi > 0 Then
MsgBox "Var", vbInformation, "BİLDİRİ"
Exit Sub
Else


Worksheets("DESİMALDOSYA").Cells(sonsatır, 2) = Tbdosyakodu.Value
Worksheets("DESİMALDOSYA").Cells(sonsatır, 3) = Tbdosyaadı.Value
MsgBox "VERİ KAYDEDİLDİ.", vbInformation, "BİLDİRİ"
Tbdosyakodu.Value = ""
Tbdosyaadı.Value = ""
listele

    Range("B2:D341").Select
    ActiveWindow.ScrollRow = 287
    ActiveWindow.ScrollRow = 144
    ActiveWindow.ScrollRow = 1
    ActiveWorkbook.Worksheets("DESİMALDOSYA").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("DESİMALDOSYA").Sort.SortFields.Add Key:=Range( _
        "B2:B341"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("DESİMALDOSYA").Sort
        .SetRange Range("B2:D341")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ActiveWindow.SmallScroll Down:=24

End Sub
 
Greenblacksea53

Greenblacksea53

Altın Üye
Katılım
5 Ocak 2019
Mesajlar
550
Excel Vers. ve Dili
Ofis 365 Tr
Altın Üyelik Bitiş Tarihi
05-01-2025
Listele altına end if eklermisiniz
 
Greenblacksea53

Greenblacksea53

Altın Üye
Katılım
5 Ocak 2019
Mesajlar
550
Excel Vers. ve Dili
Ofis 365 Tr
Altın Üyelik Bitiş Tarihi
05-01-2025
Kod: 
Private Sub Cmdkaydet_Click()
If Tbdosyakodu.Text = "" Then
MsgBox "DOSYA KODU BOŞ OLAMAZ.", vbInformation, "BİLDİRİ"
Exit Sub
ElseIf Tbdosyaadı.Text = "" Then
MsgBox "DOSYA ADI BOŞ OLAMAZ.", vbInformation, "BİLDİRİ"
Exit Sub
End If
sonsatır = WorksheetFunction.CountA(Worksheets("DESİMALDOSYA").Range("A:A")) + 1
If sonsatır = 2 Then
Worksheets("DESİMALDOSYA").Cells(sonsatır, 1) = 1
Else
Worksheets("DESİMALDOSYA").Cells(sonsatır, 1) = Worksheets("DESİMALDOSYA").Cells(sonsatır - 1, 1) + 1
End If



Set syf = Sheets("DESİMALDOSYA")
sonsatır53 = WorksheetFunction.CountA(Worksheets("DESİMALDOSYA").Range("B:B")) + 1
dsy1 = Tbdosyakodu.Value
dsy2 = Tbdosyaadı.Value
dsy1varmi = WorksheetFunction.CountIf(syf.Range("b" & sonsatır53), dsy1)
dsy2varmi = WorksheetFunction.CountIf(syf.Range("c" & sonsatır53), dsy2)
If dsy1varmi > 0 And dsy2varmi > 0 Then
MsgBox "Var", vbInformation, "BİLDİRİ"
Exit Sub
Else


Worksheets("DESİMALDOSYA").Cells(sonsatır, 2) = Tbdosyakodu.Value
Worksheets("DESİMALDOSYA").Cells(sonsatır, 3) = Tbdosyaadı.Value
MsgBox "VERİ KAYDEDİLDİ.", vbInformation, "BİLDİRİ"
Tbdosyakodu.Value = ""
Tbdosyaadı.Value = ""
listele
End If
    Range("B2:D341").Select
    ActiveWindow.ScrollRow = 287
    ActiveWindow.ScrollRow = 144
    ActiveWindow.ScrollRow = 1
    ActiveWorkbook.Worksheets("DESİMALDOSYA").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("DESİMALDOSYA").Sort.SortFields.Add Key:=Range( _
        "B2:B341"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("DESİMALDOSYA").Sort
        .SetRange Range("B2:D341")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ActiveWindow.SmallScroll Down:=24

End Sub
End if eklenmiş hali sizde aynısını eklemiştim diyorsanız, sonsatır53 değişkeninden başlayarak f8 ile manuel ilerleme yaparmısınız ? Tbdosyakodu ve Tbdosyaadı var olan bilgileri girip. B ve C sütuna kaydediyorsunuz bende B ve C sütunda girilen değer var ise uyarı versin diyorum.
 
S

sinemomec

Katılım
21 Ocak 2013
Mesajlar
422
Excel Vers. ve Dili
2010
Kod: 
Private Sub Cmdkaydet_Click()
If Tbdosyakodu.Text = "" Then
MsgBox "DOSYA KODU BOŞ OLAMAZ.", vbInformation, "BİLDİRİ"
Exit Sub
ElseIf Tbdosyaadı.Text = "" Then
MsgBox "DOSYA ADI BOŞ OLAMAZ.", vbInformation, "BİLDİRİ"
Exit Sub
End If
sonsatır = WorksheetFunction.CountA(Worksheets("DESİMALDOSYA").Range("A:A")) + 1
If sonsatır = 2 Then
Worksheets("DESİMALDOSYA").Cells(sonsatır, 1) = 1
Else
Worksheets("DESİMALDOSYA").Cells(sonsatır, 1) = Worksheets("DESİMALDOSYA").Cells(sonsatır - 1, 1) + 1
End If


Set syf = Sheets("DESİMALDOSYA")
sonsatır53 = WorksheetFunction.CountA(Worksheets("DESİMALDOSYA").Range("B:B")) + 1
dsy1 = Tbdosyakodu.Value
dsy2 = Tbdosyaadı.Value
dsy1varmi = WorksheetFunction.CountIf(syf.Range("b" & sonsatır53), dsy1)
dsy2varmi = WorksheetFunction.CountIf(syf.Range("c" & sonsatır53), dsy2)
If dsy1varmi > 0 And dsy2varmi > 0 Then
MsgBox "Var", vbInformation, "BİLDİRİ"
Exit Sub
Else


Worksheets("DESİMALDOSYA").Cells(sonsatır, 2) = Tbdosyakodu.Value
Worksheets("DESİMALDOSYA").Cells(sonsatır, 3) = Tbdosyaadı.Value
MsgBox "VERİ KAYDEDİLDİ.", vbInformation, "BİLDİRİ"
Tbdosyakodu.Value = ""
Tbdosyaadı.Value = ""
listele
End If



ActiveWindow.SmallScroll Down:=-15
    ActiveWorkbook.Worksheets("DESİMALDOSYA").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("DESİMALDOSYA").Sort.SortFields.Add Key:=Range( _
        "B2:B1000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("DESİMALDOSYA").Sort
        .SetRange Range("B1:D1000")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub
 
Greenblacksea53

Greenblacksea53

Altın Üye
Katılım
5 Ocak 2019
Mesajlar
550
Excel Vers. ve Dili
Ofis 365 Tr
Altın Üyelik Bitiş Tarihi
05-01-2025
Dosyanızı yükleme şansınız var mı ? Bakalım
 
ÖmerFaruk

ÖmerFaruk

Destek Ekibi
Destek Ekibi
Katılım
22 Ekim 2017
Mesajlar
4,655
Excel Vers. ve Dili
Microsoft 365 Tr-64
Harici dosya yükleme sitelerini kullanıp LİNK payalaşabilrisiniz.
Dosya.Co
WeTransfer
Drive gibi
 
Greenblacksea53

Greenblacksea53

Altın Üye
Katılım
5 Ocak 2019
Mesajlar
550
Excel Vers. ve Dili
Ofis 365 Tr
Altın Üyelik Bitiş Tarihi
05-01-2025
sinemomec' Alıntı:

İndir EVRAK KAYIT (Otomatik kaydedildi)

Dosyayı indir EVRAK KAYIT (Otomatik kaydedildi)
dosya.co
Genişletmek için tıkla ...
Kaydet butonuna

C++: 
' AYNI ISIM VARMI DOSYA KODU KONTROL BAŞLANGIC
For Each ayni In Sheets("DESİMALDOSYA").Range("D2:D" & sonsatır)
If ayni.Value = CStr(Tbdosyakodu.Value & " " & Tbdosyaadı.Value) Then
DsyKod = Tbdosyakodu.Value
MsgBox Tbdosyakodu & " " & Tbdosyaadı & ", verilerimiz'de kayıtlıdır.", vbCritical, "BİLDİRİ"
DsyKod = ""
Exit Sub
End If
Next
' AYNI ISIM VARMI DOSYA KODU KONTROL SON
kayıttan hemen önce ekler misiniz ?
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst