Daha önce değer girilmiş excel satırında işlem yapmak

[AliOnur05]

Merhabalar,
Öncelikle söyleyeceğim konuda bir araştırma yaptım ama bir sonuç bulamadım. Bir excel vba projesi üzerinde uğraşmaktayım.
2 tane userform üzerinden çalışıyorum, ilk girdiğim userform1 bilgilerim excel sayfasına kaydoluyor.Benim istediğim ise 2.kullandığım userform3 üzerinden girdiğim bilgilerin 1.Sütündaki PO numarası aynı ise aynı satırda işlem yapmasını bir alt satıra geçmemesini istiyorum. Özetle userform3 de gireceğim PO değeri daha önce girilmiş sütündaki değerle aynı ise o satıra girecek ve girdiğim değerlerin yanına pastal birimini yani textbox2 yi kaydedecek.
Kodlarım ise şu şekildedir;
Dim pir, sonsatir, sira, hucre As Variant
Private Sub CommandButton1_Click()
If TextBox1.Text = Empty Then
MsgBox ("PO kısmını boş geçmeyiniz"), vbOKOnly, "Uyarı!!!": Exit Sub
Else
End If
If TextBox2.Text = Empty Then
MsgBox ("Pastal Birimi yazmak mecburidir"), , "Uyarı!!!": Exit Sub
Else
End If
For Each hucre In Range("a2:a" & WorksheetFunction.CountA(Range("a1:a65000")))
If StrConv(hucre.Value, vbUpperCase) = StrConv(TextBox1.Value, vbUpperCase) Then
hucre.Select

TextBox3 = ActiveCell.Offset(0, 1).Value
End If
Next
pir = False
sonsatir = Cells(65536, 1).End(xlUp).Row
For X = 2 To sonsatir
If Cells(X, 1) & Cells(X, 3) & Cells(X, 4) = TextBox1 & TextBox2 Then
pir = True
sira = X
Exit For
End If
Next X
If pir = False Then
Cells(sonsatir + 1, 1) = TextBox1
Cells(sonsatir + 1, 4) = TextBox2
Cells(sonsatir + 1, 2) = TextBox3
MsgBox (sonsatir + 1 & ". sıraya kaydı yapıldı.")
Else
MsgBox ("Bu kayıt daha önce girilmiş..." & sira & ". satir")
End If

Unload UserForm3
Unload Me
End
End Sub

 

[Ömer]

Merhaba,

Örnek dosya ekleyerek açıklayınız.

Dosya Yükle - Dosya Upload

Dosyalarınızı ücretsiz yükleyebilir ve paylaşabilirsiniz. Dosya yükleme, Dosya Upload ücretsiz.

dosya.co

 

[AliOnur05]

Merhaba,

Örnek dosya ekleyerek açıklayınız.

Dosya Yükle - Dosya Upload

Dosyalarınızı ücretsiz yükleyebilir ve paylaşabilirsiniz. Dosya yükleme, Dosya Upload ücretsiz.

dosya.co

İndir Makro1

Dosyayı indir Makro1

dosya.co

 

[Ömer]

Eski kodların bir kısmını sildim. Kullanmanız gereken bir bölümü varsa siz eklersiniz.

Private Sub CommandButton1_Click()

    Dim S1 As Worksheet, c As Range, Adr As String

    Set S1 = Sheets("Sayfa1")

    If TextBox1.Text = Empty Then
        MsgBox ("PO kısmını boş geçmeyiniz"), vbOKOnly, "Uyarı!!!": Exit Sub
    End If
    If TextBox2.Text = Empty Then
        MsgBox ("Pastal Birimi yazmak mecburidir"), , "Uyarı!!!": Exit Sub
    End If
    
    sonsatir = Cells(Rows.Count, "A").End(xlUp).Row + 1

    Set c = S1.[A:A].Find(TextBox1.Text, , xlValues, xlWhole)
    If Not c Is Nothing Then
        Adr = c.Address
        Do
            S1.Cells(c.Row, "D") = TextBox2.Text
            Set c = S1.[A:A].FindNext(c)
        Loop While Not c Is Nothing And c.Address <> Adr
    If Not c Is Nothing Then MsgBox "Değişim Yapıldı", vbInformation
    Else
        S1.Cells(sonsatir, "A") = TextBox1.Text
        S1.Cells(sonsatir, "D") = TextBox2.Text
        S1.Cells(sonsatir, "B") = TextBox3.Text
        MsgBox "Yeni Kayıt Yapıldı", vbInformation
    End If

End Sub

 

[AliOnur05]

Ömer Bey ilginiz için çok teşekkür ederim. Projem üzerinde yapmam gereken tek bir durum daha kaldı, oda 4. sütunda girdiğim sayısal değerin yani pastal biriminin yüzdesel sapması 3.sütundaki değerimin yani teklif biriminden %2 fazla olursa hata vermesini istiyorum. Az olursa hata vermeyecek ve direkt kaydedecek.

 

[Ömer]

Formül olarak düşünürsek;

=C2*1,02>D2

Sonucu doğru dönerse kayıt yada değişimi yapmasın mı olacak. Ona göre makroya ilave edeceğim.

İlave soru: A sütunu sayı mı olacak metin mi?

 

[AliOnur05]

Ömer bey A Sütunu yani PO sayı olacak, D sütununa(pastal birimi) bir sayısal değer girildiğinde bu değer C sütunundaki(Teklif birimi) değerden yüzdesel sapma olarak %2 daha büyükse bu değeri kaydetmeyecek ve hata mesajı verecek eğer %2 değerinden daha az ise kaydedecek.
Eğer sonuç bu yukarıda dediğim gibiyse evet kayıt gerçekleşecek.
Tek kısıtımız D Sütunundaki değerin C sütunundaki değerden yüzdesel sapmasının %2 den fazla olması durumunda işlemi gerçekleştirmeyip hata vermesi , eğer ki az ise kaydedecek.

 

[Ömer]

Yeni kayıt C sütununa bir işlem yapmadığı için sadece değişim de bu şart aranacak sanırım.
Deneyiniz.

Private Sub CommandButton1_Click()

    Dim S1 As Worksheet, c As Range, Adr As String, t_b As Double, s As Byte

    Set S1 = Sheets("Sayfa1")

    If TextBox1.Text = Empty Then
        MsgBox ("PO kısmını boş geçmeyiniz"), vbOKOnly, "Uyarı!!!": Exit Sub
    End If
    If TextBox2.Text = Empty Then
        MsgBox ("Pastal Birimi yazmak mecburidir"), , "Uyarı!!!": Exit Sub
    End If
   
    sonsatir = Cells(Rows.Count, "A").End(xlUp).Row + 1

    Set c = S1.[A:A].Find(TextBox1.Text, , xlValues, xlWhole)
    If Not c Is Nothing Then
        Adr = c.Address
        Do
            t_b = S1.Cells(c.Row, "C") * 1.02
            If t_b <= CDbl(TextBox2.Text) Then
                S1.Cells(c.Row, "D") = CDbl(TextBox2.Text)
                s = s + 1
            Else
                MsgBox "Kayıt Yapılmadı" & vbLf & c.Row & " .Satır %2 den fazla" & _
                    vbLf & "Başka Kayıt Varsa Aranacak"
            End If
            Set c = S1.[A:A].FindNext(c)
        Loop While Not c Is Nothing And c.Address <> Adr
    If s > 0 Then MsgBox s & " Değişim Yapıldı", vbInformation
    Else
        S1.Cells(sonsatir, "A") = CDbl(TextBox1.Text)
        S1.Cells(sonsatir, "D") = CDbl(TextBox2.Text)
        S1.Cells(sonsatir, "B") = TextBox3.Text
        MsgBox "Yeni Kayıt Yapıldı", vbInformation
    End If

End Sub

 

[AliOnur05]

Ömer Bey elinize sağlık mantık doğru ama D satırıyla C satırın görevleri istediğimin tersi olmuş sadece D

 

[AliOnur05]

D satırının değerinin C satırından yüksek çıkmaması lazım ve ben bu işlemi userform3 deki buttonla yapıyorum.

 

[Ömer]

Bende Userfom3 için örneği yazmıştım.

Sadece doğru çözümü bulmak için;
Aşağıdaki formülü sayfadaki E2 hücresine yazın ve C2 ve D2 yi elle değiştirin. Formül DOĞRU sonucu ürettiğinde kayıt yapıyor, YANLIŞ sonucunu ürettiğinde yapmıyor demektir. Elle giriş yaparak gözlemleyin mantık yanlış mı? Yanlışsa daha detaylı açıklar mısınız.

=C2*1,02<=D2

.

 

[AliOnur05]

Ömer bey =C2*1,02<=D2 bu formülü uyguladığımızda , kaydedilmesi gerekenler doğru kaydedilmemesi gerekenler yanlış çıkıyor mesela

 

[Ömer]

Ters olmuş yani. Öyle olacaksa makro kodlarında;

If t_b <= CDbl(TextBox2.Text) Then

Buradaki <= yerine > yazarak deneyiniz.

 

[AliOnur05]

Ömer bey tekrardan ellerine sağlık tam istediğim gibi oldu şu an , ilginiz için teşekkür ediyorum.
İyi çalışmalar

 

[Ömer]

Rica ederim, iyi çalışmalar.