Menghitung Jumlah Nilai cell yang berwarna tertentu - belajar exvel vba

Menghitung Jumlah Nilai  cell yang berwarna tertentu

Anda pernah mencoba menghitung sel dengan warna di Excel, 
Anda mungkin telah memperhatikan bahwa Excel tidak mengandung
 fungsi untuk mencapai ini.

Karena fungsi seperti COUNTIF tidak dapat dihitung berdasarkan
 warna sel, kita harus membuat fungsi kustom kita sendiri 
(juga dikenal sebagai Fungsi yang Ditetapkan Pengguna atau UDF) untuk menyelesaikan pekerjaan.

Fungsi Kustom untuk Menghitung Sel dengan Warna

buka Visual Basic Editor dengan menekan Alt + F11 atau
 dengan mengklik tombol Visual Basic

Buatlah Sebuah Modul dan pastekan Kode berikut

PASTEKAN PADA  MODUL

'----------------------------

Function SumByColor(CellColor As Range, SumRange As Range)

Application.Volatile

Dim ICol As Integer

Dim TCell As Range

ICol = CellColor.Interior.ColorIndex

For Each TCell In SumRange

If ICol = TCell.Interior.ColorIndex Then

SumByColor = SumByColor + TCell.Value

End If

Next TCell

End Function

Pada table yg telah kita buat seperti gambar diatas dibuat 
dengan  warna cell yang berbeda beda  Kemudian buatlah rumus  di g4

=SumByColor(F4,$B$4:$D$11)

Selesai

Silahkan anda coba !

semoga bermanfaat

Menandai jumlah data data duplikat data excel dengan vba

PASTEKAN KODE BERIKUT PADA SEBUAH MODUL

Sub Duplicate_1Creteria()

Dim myRange, myRange1 As Range

Dim i As Integer

Dim j As Integer

Dim myCell As Range

Set myRange = Range("b3:B24")

For Each myCell In myRange

              

If WorksheetFunction.CountIf(myRange, myCell.Value) = 2 Then

myCell.Interior.ColorIndex = 6

ElseIf WorksheetFunction.CountIf(myRange, myCell.Value) = 3 Then

myCell.Interior.ColorIndex = 7

ElseIf WorksheetFunction.CountIf(myRange, myCell.Value) = 4 Then

myCell.Interior.ColorIndex = 8

ElseIf WorksheetFunction.CountIf(myRange, myCell.Value) = 5 Then

myCell.Interior.ColorIndex = 12

End If

Next

[C3:C24].Formula = "=COUNTIF($B$3:B24,B3)"

End Sub

SELAMAT MENCOBA

Mengenal KODE WARNA DGN VBA

Color Active Cell     

            Mewarnai Cell Active Dan Menormalkan Otomatis Dengan Run

Di Worksheet_Selectionchange

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

On Error Resume Next

    Application.ScreenUpdating = False

Cells.Interior.ColorIndex = 0

        ActiveCell.Interior.ColorIndex = 4

    Application.ScreenUpdating = True '

End Sub         

Color Border Target          

            Target Border Activecell 

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Dim strRange As String

strRange = Target.Cells.Address & "," & _

Target.Cells.EntireColumn.Address & "," & _

Target.Cells.EntireRow.Address

Range(strRange).Select

End Sub

Color Copy Background   

            Copy Pastespecial Xlpasteformats Warna       

Sub BackGroundColour()

Range("a1:d1").Copy

Range("a3:d3").PasteSpecial xlPasteFormats

End Sub

Color Copy Only     

            Copy Paste Khusus Warna Copy Range("F1:F50") Ke Kolom C

Sub copycolors()

  Dim cell As Range, s As String

s = "C"

  For Each cell In Range("F1:F50")

    Range("C" & cell.Row).Interior.Color = cell.Interior.Color

  Next cell

End Sub         

Color Count

            Menghitung Cell Berwarna Tertentu

 Cara Pakainya  Misalnya    =Countbycolor ("A5")   

Function CountByColor(CellColor As Range, CountRange As Range)

Application.Volatile

Dim ICol As Integer

Dim TCell As Range

ICol = CellColor.Interior.ColorIndex

For Each TCell In CountRange

If ICol = TCell.Interior.ColorIndex Then

CountByColor = CountByColor + 1

End If

Next TCell

End Function

Color Front Kreteria         

                 Mewarnai Hurup Dengan Acuan Nilai Kreteria  Di Cells(I, 2) Atau Dikolom B        

Sub sampel ()

For i = 1 To 20

If Cells(i, 2).Value > 50 Then

Cells(i, 2).Font.ColorIndex = 5

Else

Cells(i, 2).Font.ColorIndex = 3

End If

Next i

End Sub

Color Indek

Menampilkan Semua Warna Dengan Kode Angka

           

For i = 1 To 56

Cells(i, 2).Interior.ColorIndex = i

Cells(i, 2) = i

Next i

Color Shape 

Mewarnai Shapes("Textbox 1") Activesheet

Sub warna()

With ActiveSheet

.Shapes("TextBox 1").Fill.ForeColor.RGB = vbWhite

.Shapes("TextBox 2").Fill.ForeColor.RGB = vbWhite

.Shapes("TextBox 3").Fill.ForeColor.RGB = vbWhite

End With

End Sub

Mewarnai data duplikat

        Mewarnai data duplikat

Materi kali ini kita akan membahas bagaimana menemukan data ganda atau duplikat  ,Hal ini sangat penting bagi seorang operator pengolah data , apalagi jumlah data sampai ruan data sehingga secara manual akan sulit dilakukan
Dengan fasilitas VBA kita akan menemukan dan otomatis menandai data yang dianggap ganda
Carannya cukup mudah dengan membuat Modul
Pastekan kode berikut :

Kode ini mengacu pada data di kolom B

Sub ganda()
Dim LastRow As Long
Dim matchFoundIndex As Long
Dim iCntr As Long
LastRow = Range("b65000").End(xlUp).Row
For iCntr = 2 To LastRow
If Cells(iCntr, 2) <> "" Then
matchFoundIndex = WorksheetFunction.Match(Cells(iCntr, 2), Range("b1:b" & LastRow), 0)
If iCntr <> matchFoundIndex Then
Cells(iCntr, 2).Interior.Color = vbRed
Cells(iCntr, 2).Font.Color = vbWhite
End If
End If
Next
End Sub

Selesai
Semoga Bermanfaat

Sum by Color

Menghitung Jumlah cell yang berwarna

Anda pernah mencoba menghitung sel dengan warna di Excel, Anda mungkin telah memperhatikan bahwa Excel tidak mengandung fungsi untuk mencapai ini.
Karena fungsi seperti COUNTIF tidak dapat dihitung berdasarkan warna sel, kita harus membuat fungsi kustom kita sendiri (juga dikenal sebagai Fungsi yang Ditetapkan Pengguna atau UDF) untuk menyelesaikan pekerjaan.
Fungsi Kustom untuk Menghitung Sel dengan Warna
buka Visual Basic Editor dengan menekan Alt + F11 atau dengan mengklik tombol Visual Basic
Buatlah Sebuah Modul dan pastekan Kode berikut

PASTEKAN PADA MODUL
'----------------------------
Function ColorFunction(rColor As Range, rRange As Range, Optional SUM As Boolean)
Dim rCell As Range
Dim lCol As Long
Dim vResult
lCol = rColor.Interior.ColorIndex
If SUM = True Then
For Each rCell In rRange
If rCell.Interior.ColorIndex = lCol Then
vResult = WorksheetFunction.SUM(rCell, vResult)
End If
Next rCell
Else
For Each rCell In rRange
If rCell.Interior.ColorIndex = lCol Then
vResult = 1 + vResult
End If
Next rCell
End If
ColorFunction = vResult
End Function

Kemudian buatlah table seperti gambar diatas dengan  warna cell yang berbeda beda
Kemudian buatlah rumus  di g4

=colorfunction(F4,$B$4:$D$11,FALSE)

Menandai Data Ganda

        Menandai Data Ganda

Pembahasaan saat ini adalah mencari dan menemukan data ganda atau data duplikat . Model pencarian ini sangat bermanfaat apabila kita dihadapkan oleh Ratusan data bahkan Ribuan data  untuk dapat menemukan data ganda misalnya data pemilih ganda
dengan Bantuan Visual Basic Kita akan dapat menemukan dgn mudah bahkan dalam waktu 1 menit kita dapat mengatasi ribuuan data menemukan dan menandainya

Cukup Mudah  caranya Pastekan kode berikut pada Sebuah Modul
Yang mengacu pada kolom b  baris ke 2

LastRow = Range("b65000").End(xlUp).Row
For iCntr = 2 To LastRow

Kode lengkapnya :

Sub Tampilkan()
Dim LastRow As Long
Dim matchFoundIndex As Long
Dim iCntr As Long
LastRow = Range("b65000").End(xlUp).Row
For iCntr = 2 To LastRow
If Cells(iCntr, 2) <> "" Then
matchFoundIndex = WorksheetFunction.Match(Cells(iCntr, 2), Range("b1:b" & LastRow), 0)
If iCntr <> matchFoundIndex Then
Cells(iCntr, 2).Interior.Color = vbRed
Cells(iCntr, 2).Font.Color = vbWhite
End If
End If
Next
End Sub

Selesai
Semoga bermanfaat
Silahkan klik halaman Download dibawah ini


 Data Ganda