AYNI DEĞERİN HARF KODUNU DEĞİŞTİRME

[ilker29]

Merhaba arkadaşlar

Ekli dosyada iş yerinde kullanmak için hazırladığım tablo var. İstediğim şekilde çalışmakta ama bir özellik daha istiyorum içinden çıkamadım.
Arıza alarmlarını raporladığım bu tablo, A1 hücresine "1" ve B1 hücresine "2" ve arıza kodu ise C1 hücresinde "E"dir.
Program çalıştırıldığında textbox1'e "1", textbox2'ye "2" Textbox3'e "M" arızasını yazdığımda bir önceki Arızayı bularak "M" yazmasını istiyorum.
Yani yeni satır oluşturmadan eski "E" yazısının silinmesini ve "M" kodunun yazılmasını istiyorum.
Bana bu konuda yardımcı olabilir misiniz?
Hoşçakalın

 

[Korhan Ayhan]

Merhaba,

Formunuza bir buton ekleyip aşağıdaki kodu deneyiniz. Kod kritere uyan ilk satırı değiştirecektir.

Private Sub CommandButton1_Click()
    If TB1 = "" Then Exit Sub
    If TB2 = "" Then Exit Sub
    If TB3 = "" Then Exit Sub

    Last_Row = Cells(Rows.Count, 1).End(3).Row
    My_Formula = "SMALL(IF(A2:A1048576=" & TB1 & ",IF(B2:B1048576=" & TB2 & ",ROW(A2:A1048576))),1)"
    My_Formula = Replace(My_Formula, 1048576, Last_Row)
    Change_Row = Evaluate(My_Formula)
    If Change_Row > 1 Then Cells(Change_Row, "C") = TB3
End Sub

 

[ilker29]

Sanırım yanlış anlaşıldı. ilave bir buton ile değil benim hazırladığım formdaki userform içinde bulunan TB3 (textbox3'e) ek bir kod istemiştim. Buton ile değil TB3'e harf yazdığımda denetim yapıp, aynı rakamlardan var ise var olan arıza kodunu değiştirmeli. Aynı rakamlardan yok ise sayfa sonuna yazmalı

 

[Korhan Ayhan]

Deneyiniz.

Private Sub TB3_Change()
    If TB1 = "" Then Exit Sub
    If TB2 = "" Then Exit Sub
    If TB3 = "" Then Exit Sub

    Last_Row = Cells(Rows.Count, 1).End(3).Row
    My_Formula = "IFERROR(SMALL(IF(A2:A1048576=" & TB1 & ",IF(B2:B1048576=" & TB2 & ",ROW(A2:A1048576))),1),0)"
    My_Formula = Replace(My_Formula, 1048576, Last_Row)
    Change_Row = Evaluate(My_Formula)
    If Change_Row > 1 Then
        Cells(Change_Row, "C") = TB3
        Exit Sub
    End If
    
    sonsatir1 = WorksheetFunction.CountA(Worksheets("sayfa1").Range("A:A")) + 1
    sonsatir2 = WorksheetFunction.CountA(Worksheets("sayfa1").Range("F:F")) + 1
    
    Select Case TB3
        Case ".NFC", "E", "C", "I", "M", "O", "P", "B", "D", "R", "L", "K", "GE", "OK", "ÇS", "OM", "H", "A", "F", "Com", "S", "Y", "N", "F", "YE", "U"
        
        If IsNumeric(TB1.Value) Then
            If IsNumeric(TB2.Value) Then
                If Not IsNumeric(TB3.Value) Then
                    If TB3.Value = "L" Then
                        Worksheets("sayfa1").Cells(sonsatir2, 6) = TB1.Value
                        Worksheets("sayfa1").Cells(sonsatir2, 7) = TB2.Value
                        Worksheets("sayfa1").Cells(sonsatir2, 8) = TB3.Value
                        Worksheets("sayfa1").Cells(sonsatir2, 6).Select
                    Else
                        Worksheets("sayfa1").Cells(sonsatir1, 1) = TB1.Value
                        Worksheets("sayfa1").Cells(sonsatir1, 2) = TB2.Value
                        Worksheets("sayfa1").Cells(sonsatir1, 3) = TB3.Value
                        Worksheets("sayfa1").Cells(sonsatir1, 1).Select
                    End If
                Else
                    Exit Sub
                End If
            Else
                Exit Sub
            End If
        Else
            Exit Sub
        End If
    End Select
End Sub

 

[ilker29]

Teşekkür ederim zaman ayırdığınız için.
Kontrol ettim. Önceki yazılan arıza kodunu değiştirme çalışıyor fakat yeni benzersiz kod yazdığımda en sondaki boşluğa ekleme yapmıyor.

 

[Korhan Ayhan]

Son önerimi tekrar revize ettim. Deneyiniz.

 

[ilker29]

Çok Teşekkür ederim. Tam istediğim gibi oldu. Hoşçakalın