Gelişmiş Arama Yapma

[postmix]

Arkadaşlar merhaba. elimde bir tablo var. Adisyon tablosu 50 adetli adisyonların numaraları tek tek yazıyor. Her garsona verilen adisyonlar belli zaten. Fakat gün sonunda tek tek adisyona ve excele bakıp bana geldi anlamında bi renge boyamak çok uzun zaman alıyor.Çünkü işler yoğun ve çok adisyon var günlük. tabloyu ekliyorum arkadaşlar. Yapmak istediğim şey ise. Mesela bi text kutusu olacak ben bu adisyon numaralarını buraya yazacağım ve ok dediğimde yazdığım adisyonların hücresini bulup örnek vermek için söylüyorum kırmızıya boyayacak. İşi bilenler için zor olmasa gerek. yardımlarınızı umuyorum.Teşekkürler.

 

[hamitcan]

Private Sub TextBox1_Change()
    For Each hcr In UsedRange
        If TextBox1.Text = "" Then Exit Sub
            If TextBox1.Text = hcr.Text Then
                If MsgBox("Renk Verilsin Mi, Silinsin Mi ?", vbYesNo) = vbYes Then
                    Range(hcr.Address).Interior.Color = vbRed
                Else
                Range(hcr.Address).Interior.Color = xlAutomatic
                End If
            End If
    Next
End Sub

 

[postmix]

yardımın için çok teşekkürler. çok güzel olmuş. peki numarayı bulup veri renklensin mi diye sorduktan sonra enter'a (evete) bastığımızda text kutusu kendisini temizleyebilir mi ? küçük bir formül yaması koyarsan sevinirim kardeş

 

[hamitcan]

Private Sub TextBox1_Change()
    For Each hcr In UsedRange
        If TextBox1.Text = "" Then Exit Sub
            If TextBox1.Text = hcr.Text Then
                If MsgBox("Renk Verilsin Mi, Silinsin Mi ?", vbYesNo) = vbYes Then
                    Range(hcr.Address).Interior.Color = vbRed
                   [COLOR=RED] TextBox1=""[/COLOR]
                Else
                Range(hcr.Address).Interior.Color = xlAutomatic
                End If
            End If
    Next
End Sub

 

[postmix]

kardeş bu kodu işleme aldım evet text kutusunu temizliyor ama kırmızıya boyamıyor hücreyi şimdide ? bi bakabilir misin ?

 

[postmix]

Private Sub TextBox1_Change()
    For Each hcr In UsedRange
        If TextBox1.Text = "" Then Exit Sub
            If TextBox1.Text = hcr.Text Then
                If MsgBox("Renk Verilsin Mi, Silinsin Mi ?", vbYesNo) = vbYes Then
                    Range(hcr.Address).Interior.Color = vbRed
                   [COLOR=RED] TextBox1=""[/COLOR]
                Else
                Range(hcr.Address).Interior.Color = xlAutomatic
                End If
            End If
    Next
End Sub

şu formülü bi update etseniz son kez text kutusu temizleniyor ama hücreye renk vermiyor..

 

[Korhan Ayhan]

Aşağıdaki kodu deneyiniz.

Private Sub TextBox1_Change()
    Dim Bul As Range, Adres As String
    
    If TextBox1 = "" Then Exit Sub
    
    Set Bul = Range("A:K").Find(TextBox1, , xlValues, xlWhole)
    If Not Bul Is Nothing Then
    Adres = Bul.Address
        Do
            If MsgBox("Bulunan veri renklendirilsin mi?", vbCritical + vbYesNo) = vbYes Then
                Bul.Interior.ColorIndex = 3
            Else
                Bul.Interior.ColorIndex = xlNone
            End If
            Set Bul = Range("A:K").FindNext(Bul)
        Loop While Not Bul Is Nothing And Bul.Address <> Adres
        TextBox1 = ""
    End If
End Sub

 

[postmix]

Aşağıdaki kodu deneyiniz.

Private Sub TextBox1_Change()
    Dim Bul As Range, Adres As String
    
    If TextBox1 = "" Then Exit Sub
    
    Set Bul = Range("A:K").Find(TextBox1, , xlValues, xlWhole)
    If Not Bul Is Nothing Then
    Adres = Bul.Address
        Do
            If MsgBox("Bulunan veri renklendirilsin mi?", vbCritical + vbYesNo) = vbYes Then
                Bul.Interior.ColorIndex = 3
            Else
                Bul.Interior.ColorIndex = xlNone
            End If
            Set Bul = Range("A:K").FindNext(Bul)
        Loop While Not Bul Is Nothing And Bul.Address <> Adres
        TextBox1 = ""
    End If
End Sub

Süper olmuş arkadaşım. Ellerinize sağlık...