Ambar takip için excel kodu arıyoru

[mehmetk4r4]

beyanname tarih/no :
eşya durumu:
eşyanın bulubdugu rejim :
gelen ürünün adı :
firma :
miktar :
kap adeti :
konteyner no:
araç plaka /sefer :
kırılan mühür:
açıklama:
bunları kayıt altına tutacak bir excel yapılabilir mi
lütfen yardım

 

[harziyan]

http://www.excel.web.tr/showthread.php?t=48862&highlight=userform+olu%FEturmak Sevgili kardeşim bu linkte istediğini kendi kendine nasıl yapacağın hususunda ayrıntılı bilgiler mevcut. Kesinlikle istifade etmen lazım ya da forumda kullanılan veri yönetimi ile ilgili benzer dosyalardan bir tanesini alıp evirip çevireceksin. Kolay gelsin...

 

[N.Ziya Hiçdurmaz]

yanıt

Private Sub TextBox1_Change()
On Error Resume Next
Dim sat As Long
Range("a2:a6000").EntireRow.Hidden = False
Application.ScreenUpdating = False
    For sat = 2 To Cells(65536, "a").End(xlUp).Row
        Cells(sat, "a").EntireRow.Hidden = True
        If Cells(sat, "a") Like "*" & TextBox1 & "*" Then
            Cells(sat, "a").EntireRow.Hidden = False
            Else
            Cells(sat, "a").EntireRow.Hidden = True
         End If
    Next
Application.ScreenUpdating = True
End Sub

Private Sub TextBox2_Change()
On Error Resume Next
Dim sat As Long
Range("d2:d6000").EntireRow.Hidden = False
Application.ScreenUpdating = False
    For sat = 2 To Cells(65536, "d").End(xlUp).Row
    deg1 = UCase(Replace(Replace(Cells(sat, "d"), "ı", "I"), "i", "İ"))
    deg2 = UCase(Replace(Replace(TextBox2, "ı", "I"), "i", "İ"))
        Cells(sat, "d").EntireRow.Hidden = True
        If deg1 Like deg2 & "*" Then
            Cells(sat, "d").EntireRow.Hidden = False
            Else
            Cells(sat, "d").EntireRow.Hidden = True
         End If
    Next
Application.ScreenUpdating = True
End Sub

Private Sub TextBox3_Change()
On Error Resume Next
Dim sat As Long
Range("e2:e6000").EntireRow.Hidden = False
Application.ScreenUpdating = False
    For sat = 2 To Cells(65536, "e").End(xlUp).Row
        deg1 = UCase(Replace(Replace(Cells(sat, "e"), "ı", "I"), "i", "İ"))
        deg2 = UCase(Replace(Replace(TextBox3, "ı", "I"), "i", "İ"))
        Cells(sat, "e").EntireRow.Hidden = True
        If deg1 Like deg2 & "*" Then
            Cells(sat, "e").EntireRow.Hidden = False
            Else
            Cells(sat, "e").EntireRow.Hidden = True
         End If
    Next
Application.ScreenUpdating = True
End Sub

 

[muratozmenler]

beyanname tarih/no :
Eşya durumu:
Eşyanın bulubdugu rejim :
Gelen ürünün adı :
Firma :
Miktar :
Kap adeti :
Konteyner no:
Araç plaka /sefer :
Kırılan mühür:
Açıklama:
Bunları kayıt altına tutacak bir excel yapılabilir mi
lütfen yardım

işinize yararmı?