Msgbox

[1903emre34@gmail.com]

Merhaba,

Renklendir düğmesi, "G" 'deki 260, "H" 3,15 farklı olduğu takdirde yeşil alanı renklendiriyor, örneğin "A11 hücresinde olduğu gibi, renklendir düğmesine bastığımız zaman Msgbox aracılığıyla ekrana "A" sütundaki hesap türü (260.04.0100) gelmesi için kodlarda nasıl değişiklik yapılabilir?

http://s6.dosya.tc/server10/twj7gu/Msgbox.zip.html

 

[ÖmerBey]

Merhaba,
Deneyiniz...

Sub Düğme1_Tıklat()
    Dim a, c As Range, Adr As String, i As Byte, s As Byte, s1 As Byte

    Range("A2:C" & Rows.Count).Interior.ColorIndex = 0
    
    a = Split(Range("H2"), ",")
    With Range("A:A")
        Set c = .Find(Range("G2") & "*", , xlValues, xlWhole)
        If Not c Is Nothing Then
            Adr = c.Address
            Do
                s = UBound(a) + 1: s1 = 0
                For i = 0 To UBound(a)
                    If Cells(c.Row, "C") <> Val(a(i)) Then
                        s1 = s1 + 1
                    End If
                    If s = s1 Then
                        Cells(c.Row, "A").Resize(1, 3).Interior.ColorIndex = 10
                        [COLOR="red"]liste = liste & vbLf & Cells(c.Row, "A").Value[/COLOR]
                    End If
                Next i
                Set c = .FindNext(c)
            Loop While Not c Is Nothing And c.Address <> Adr
        End If
    End With
    [COLOR="Red"]MsgBox "HESAP TÜRLERİ:" & liste[/COLOR]
End Sub

 

[Asri]

Merhaba,

Renklendir düğmesi, "G" 'deki 260, "H" 3,15 farklı olduğu takdirde yeşil alanı renklendiriyor, örneğin "A11 hücresinde olduğu gibi, renklendir düğmesine bastığımız zaman Msgbox aracılığıyla ekrana "A" sütundaki hesap türü (260.04.0100) gelmesi için kodlarda nasıl değişiklik yapılabilir?

http://s6.dosya.tc/server10/twj7gu/Msgbox.zip.html

Altrnatif;

Doğru anladıysam eğer, bu kodu deneyiniz.

Sub Düğme1_Tıklat()
    Dim a, c As Range, Adr As String, i As Byte, s As Byte, s1 As Byte

    Range("A2:C" & Rows.Count).Interior.ColorIndex = 0
    
    a = Split(Range("H2"), ",")
    With Range("A:A")
        Set c = .Find(Range("G2") & "*", , xlValues, xlWhole)
        If Not c Is Nothing Then
            Adr = c.Address
            Do
                s = UBound(a) + 1: s1 = 0
                For i = 0 To UBound(a)
                    If Cells(c.Row, "C") <> Val(a(i)) Then
                        s1 = s1 + 1
                    End If
                    If s = s1 Then
                        Cells(c.Row, "A").Resize(1, 3).Interior.ColorIndex = 10
                    [COLOR=Red]    MsgBox (Cells(c.Row, "A"))[/COLOR]
                    End If
                Next i
                Set c = .FindNext(c)
            Loop While Not c Is Nothing And c.Address <> Adr
        End If
    End With
    
End Su