Yardım Tabloda sarı renkli değerleri saymak

erkan

Yeni Üye
Katılım
3 Şub 2019
Mesajlar
18
Puanları
1
Yaş
40
Konum
İstanbul
Ad Soyad
Erkan Öztürk
Selamlar herkese hayırlı bayramlar dilerim. Ekte ki tabloda e2 ile aı2 satırı arasındaki sarı renkli sütunlardaki YİH,TR,Bİ,Üİ,İK gibi terimleri aj sütununda nasıl toplayabilirim?Her personel için ayrı ayrı e3 ile aı3 arası e4 ile aı4 arası ...gibi .İyi günler dilerim yardımlarınız içn şimdiden teşekkür ederim.
 

Ekli dosyalar

Evren

Uzman
Katılım
9 Haz 2018
Mesajlar
101
Puanları
28
Yaş
58
Konum
Emekli
Formülle değilde kod ile.Butona basın çalışacak.:cool:
Dosyanız ektedir.
Kod:
Sub topla_59()
Dim i As Long, j As Integer, sonsat As Long
Dim YIH As Byte, TR As Byte, BI As Byte, UI As Byte, IK As Byte
sonsat = Cells(Rows.Count, "B").End(xlUp).Row
Range("AJ2:AJ" & Rows.Count).ClearContents
For i = 2 To sonsat
    For j = 5 To 35
        If Cells(i, j).Interior.Color = vbYellow Then
            Select Case Cells(i, j).Value
                Case "YİH"
                    YIH = YIH + 1
                Case "TR"
                    TR = TR + 1
                Case "Bİ"
                    BI = BI + 1
                Case "Üİ"
                    UI = UI + 1
                Case "İK"
                    IK = IK + 1
            End Select
        End If
    Next j
    Cells(i, j).Value = YIH + TR + BI + UI + IK
    YIH = 0: TR = 0: BI = 0: UI = 0: UI = 0: IK = 0
Next i
MsgBox "bitti"
           
End Sub
 

Ekli dosyalar

erkan

Yeni Üye
Katılım
3 Şub 2019
Mesajlar
18
Puanları
1
Yaş
40
Konum
İstanbul
Ad Soyad
Erkan Öztürk
Formülle değilde kod ile.Butona basın çalışacak.:cool:
Dosyanız ektedir.
Kod:
Sub topla_59()
Dim i As Long, j As Integer, sonsat As Long
Dim YIH As Byte, TR As Byte, BI As Byte, UI As Byte, IK As Byte
sonsat = Cells(Rows.Count, "B").End(xlUp).Row
Range("AJ2:AJ" & Rows.Count).ClearContents
For i = 2 To sonsat
    For j = 5 To 35
        If Cells(i, j).Interior.Color = vbYellow Then
            Select Case Cells(i, j).Value
                Case "YİH"
                    YIH = YIH + 1
                Case "TR"
                    TR = TR + 1
                Case "Bİ"
                    BI = BI + 1
                Case "Üİ"
                    UI = UI + 1
                Case "İK"
                    IK = IK + 1
            End Select
        End If
    Next j
    Cells(i, j).Value = YIH + TR + BI + UI + IK
    YIH = 0: TR = 0: BI = 0: UI = 0: UI = 0: IK = 0
Next i
MsgBox "bitti"
          
End Sub
Teşekkürler hocam süpersiniz elinize emeğinize sağlık.
 

erkan

Yeni Üye
Katılım
3 Şub 2019
Mesajlar
18
Puanları
1
Yaş
40
Konum
İstanbul
Ad Soyad
Erkan Öztürk
Teşekkürler hocam süpersiniz elinize emeğinize sağlık.
Hocam tekrar emeğinize sağlık süpersiniz birde ayrıca yine sarı sütun içindeki YİH,Bİ,Üİ,İK,TR gibi verileri seçip temizleme için yardımcı olabilir misiniz ?Buda diğer tabloda lazım …
 

Evren

Uzman
Katılım
9 Haz 2018
Mesajlar
101
Puanları
28
Yaş
58
Konum
Emekli
Buyurun.:cool:
Kod:
Sub sil_59()
Dim i As Long, j As Integer, sonsat As Long
Dim YIH As Byte, TR As Byte, BI As Byte, UI As Byte, IK As Byte
sonsat = Cells(Rows.Count, "B").End(xlUp).Row
Range("AJ2:AJ" & Rows.Count).ClearContents
For i = 2 To sonsat
    For j = 5 To 35
        If Cells(i, j).Interior.Color = vbYellow Then
            Select Case Cells(i, j).Value
                Case "YİH"
                    Cells(i, j).ClearContents
                Case "TR"
                    Cells(i, j).ClearContents
                Case "Bİ"
                    Cells(i, j).ClearContents
                Case "Üİ"
                    Cells(i, j).ClearContents
                Case "İK"
                    Cells(i, j).ClearContents
            End Select
        End If
    Next j
Next i
MsgBox "silindi"
            
End Sub
 

erkan

Yeni Üye
Katılım
3 Şub 2019
Mesajlar
18
Puanları
1
Yaş
40
Konum
İstanbul
Ad Soyad
Erkan Öztürk
Buyurun.:cool:
Kod:
Sub sil_59()
Dim i As Long, j As Integer, sonsat As Long
Dim YIH As Byte, TR As Byte, BI As Byte, UI As Byte, IK As Byte
sonsat = Cells(Rows.Count, "B").End(xlUp).Row
Range("AJ2:AJ" & Rows.Count).ClearContents
For i = 2 To sonsat
    For j = 5 To 35
        If Cells(i, j).Interior.Color = vbYellow Then
            Select Case Cells(i, j).Value
                Case "YİH"
                    Cells(i, j).ClearContents
                Case "TR"
                    Cells(i, j).ClearContents
                Case "Bİ"
                    Cells(i, j).ClearContents
                Case "Üİ"
                    Cells(i, j).ClearContents
                Case "İK"
                    Cells(i, j).ClearContents
            End Select
        End If
    Next j
Next i
MsgBox "silindi"
           
End Sub
Çok teşekkürler hocam emeğinize sağlık Allah razı olsun sizden.
 

erkan

Yeni Üye
Katılım
3 Şub 2019
Mesajlar
18
Puanları
1
Yaş
40
Konum
İstanbul
Ad Soyad
Erkan Öztürk
Rica ederim.
İyi çalışmalar.:cool:
Hocam her şey için çok teşekkürler personel maaş hesaplaması için yaptığım çalışmaya siz ve Excel Turkey formundan aldığım yardımlar sayesinde sona geldim yalnız sizin yazdığınız kodlar süper çalışıyor ama ben renklendirmeyi koşullu biçimlendirmeyle yaptığım için çalışmıyor.Tabloyu tekrar ekledim e2:aı2 aralığında Pazar yazan sütunu sarıya boyamak için desteğinize ihtiyacım var.e2=Pazar ise e2:e20 arasını sarı yada k2=Pazar ise k2:k20 ...arasını sarı nasıl yaparım.Manuel sarı yapınca kodlar çalışıyor.Yine çözüm makro galiba :) ...
 

Ekli dosyalar

Evren

Uzman
Katılım
9 Haz 2018
Mesajlar
101
Puanları
28
Yaş
58
Konum
Emekli
Dosyanız ektedir.:cool:
Kod:
Sub pazar_59()
Dim sonsat As Long, i As Long
Range("E:AI").Interior.ColorIndex = xlNone
sonsat = Cells(Rows.Count, "B").End(xlUp).Row
For i = 5 To 35
    If Cells(1, i).Value = "Pazar" Then Range(Cells(1, i), Cells(sonsat, i)).Interior.Color = vbYellow
Next i
MsgBox "İşlem Bitti."
End Sub
 

Ekli dosyalar

erkan

Yeni Üye
Katılım
3 Şub 2019
Mesajlar
18
Puanları
1
Yaş
40
Konum
İstanbul
Ad Soyad
Erkan Öztürk
Dosyanız ektedir.:cool:
Kod:
Sub pazar_59()
Dim sonsat As Long, i As Long
Range("E:AI").Interior.ColorIndex = xlNone
sonsat = Cells(Rows.Count, "B").End(xlUp).Row
For i = 5 To 35
    If Cells(1, i).Value = "Pazar" Then Range(Cells(1, i), Cells(sonsat, i)).Interior.Color = vbYellow
Next i
MsgBox "İşlem Bitti."
End Sub
Hocam çok teşekkürler emeğinize sağlık Allah sizden razı olsun.
 
Üst Alt