Cara Mudah Mengubah Rumus Excel menjadi Kode VBA

1.Average cell celection

Sub selection_cell()

Dim data As Range

Set data = Selection

ActiveCell.Offset(0, 1).Value = Application. Average (data)

End sub

2.Average as Range

Sub tes_ Average ()

On Error Resume Next

 Set y = Range("C2")

  Set Data = Range("A2:A20")

  y.Value = Application. Average (Data)

  Application.DisplayFormulaBar = False

 End Sub

Sub tes_Index ()

Range(“C2”).formula=”= Average (A2:A20)”

 End Sub

contoh sampel xlsm

Average <https://1drv.ms/x/s!AuCkwAhuhUDhhX9_pZ0NEe5jc7WP?e=Uw2sJq>

3.Sub Total

Sub tes_Subtotal ()

   Set y= Range(“b1”)

  Set x= Range(“a1:a20”)

  y.Formula = "= Subtotal( 109,"& x.Address & ")"

  Application.DisplayFormulaBar = False

 End Sub

3.Sub Total selectionCell

Sub selection_cell()

Dim x As Range

Set x = Selection

ActiveCell.Offset(0, 1).Value = Application. Subtotal (109,x)

End sub

4.Aplication Index      

Formula Index dengan Memilih area cell  select

Sub selection_cell()

Dim data As Range

Set data = Selection

ActiveCell.Offset(0, 1).Value = Application.index(data,c2)

End sub

Sub tes_Index()

   Set y = Range("C2")

  Set Data = Range("A2:A20")

  y.Value = Application.Index(Data, 2)

  Application.DisplayFormulaBar = False

 End Sub

Sub tes_Index ()

Range(“C2”).formula=”=Index(A2:A20,2)”

 End Sub

5         Application Choose    

Menampilkan Hasil Pilihan Berdasarkan Nomor Indeks       

Sub formula_ Choose ()

On Error Resume Next

Set y = Range("d2")

Set Z = Range("C2")

y1 = Range("b2")

y2 = Range("b3")

y3 = Range("b4")

y.Value = Application.Choose(Z, y1, y2, y3)

End Sub

Sub formula_ Choose ()

Range(“C2”).formula=”= Choose(1, "Alan", "Bob", "Carol")”

 End Sub

6         Application  Countblank     

              Mengetahui Jumlah Sel-Sel Kosong Dalam

              Suatu Range Tertentu.

Sub COUNTBLANK_test1()

Range("A2:B10").Select

'Mengetahui Jumlah Sel-Sel Kosong Dalam Suatu Range Tertentu.

'=COUNTBLANK(C2:C10)

Range("D2").Formula = "= COUNTBLANK(A2:B10)"

End Sub

7                     Function  Multy Mode Formula Array

Sheet1.Range("G6").FormulaArray = "=SUMIF(B5:B50,G4,D5:D50)"

Sheet1.Range("G7").FormulaArray = "=g6-g5"

Sheet1.Range("G3").FormulaArray = "=COUNTIF(B5:E50,G4)"

Sheet1.Range("G11").FormulaArray = "=G9-G10"

Sheet1.Range("G4").FormulaArray = "=vLOOKUP(E4,k4:l13,2)"

                                    

8         Application Left

          

Sub Formula_Left1()

'ambil karakter dari depan

Range("D2").Formula = "=LEFT(B2,2)"

 End Sub

9         Application  fungsion Average              

          

Sub test ()

Set xx = Sheets("sheet1").Range("A1:A10")

ActiveSheet.Range("A1") = Application.average(xx)

End Sub

Sub coba ()

On Error Resume Next

Set xx = Application.InputBox("Select", Type:=8)

‘aplikasi InputBox

    ActiveSheet.Range("A1").Formula = "=average ("& xx.Address & ")"

End Sub

10       Application  Formula If & Sum     

                      

Sub hitung()

[i3].Formula = "=(IF(B3 <0,0,G4))"

[i4:i100].Formula = "=(IF(B4 = 0,0,SUM($G$3:G4)-SUM($H$3:H4)))"

End Sub

Sub reset()

Worksheets("Transaksi").Range("i3:i100").Value = ""

End Sub

Sub hitung()

[m3].Formula = "=(IF(b3 <0,0,K4))"

[m4:M1000].Formula = "=(IF(b4 = 0,0,SUM($K$3:K4)-SUM($L$3:L4)))"

End Sub

11 Application Countif                     

                       

Sub formula_countif ()        

Range("J4") = Application.CountIf(Range("E6:E56"), "L")           

Range("L4") = Application.CountIf(Range("E6:E56"), "P")          

Range("K4") = Application.CountA(Range("d6:d56"))    

end sub         

           

Sub Function_CountIf ()      

Sheets("Sheet2").Range("B3") = WorksheetFunction.CountIf(Sheets("Sheet1").Columns(3), "L")    

End Sub         

                       

12       Application Code      

            menghasilkan  No dari sebuah Karakter   

           

Sub Karakter_number1()    

'menghasilkan  No dari sebuah Karakter  

Range("D2").Formula = "=CODE(C2)"       

Range("D2:D10").FillDown 

End Sub         

           

           

13       Application formula Datedif            

                       

Sub test()      

[d3:D32].Formula = "=Datedif(B3,C3,$D$1)"       

[e3:e32].Formula = "=Datedif (B3,C3,$E$1)"        

[f3:f32].Formula = "=Datedif(B3,C3,$F$1)"          

End Sub         

           

Sub datedif1()          

Range("e3").Formula = "=Datedif (B3,C3,$E$1)" 

Range("e3:e7").FillDown     

End Sub         

           

           

14       Application Function Udf     

            Membuat Fungsi Dengan Vba        

           

Function hitung(a, b, c)       

‘Contoh Rumus  : = hitung(2,3,5)   

hitung = 100 * a + 10 * b + c           

End Function

           

Function jumlah(a, b, c)       

‘Contoh Rumus = Jumlah (2,3,5)    

Jumlah = 100 + a + 100+ b + c       

End Function

                       

15       Application Index                 

           

Sub coba()    

[a1].Formula = "=INDEX(B7:G11,1,1)"      

End Sub         

                                                                                                                       

Sub index2() 

With Sheets("SHEET1")       

 Sheets("SHEET2").Range("a1").Value = Application.index(.Range("b7:g11"), .Range("h7"), .Range("i7"))  

End With       

End Sub         

           

           

16       Application  OR         

                       

           

Sub test1()    

Range("c1") = "Gagal"          

Range("d1") = "Lulus"         

'Menghasilkan True Jika Beberapa Argumen Bernilai Benar     

'Dan False Jika Semua Argumen Salah      

'=IF(OR(D8<60,E8<60)," Gagal "," Lulus ")           

Range("F2").Formula = "= IF(OR(B2<60, C2<60, D2<60),$C$1,$D$1)"

  Application.DisplayFormulaBar = False  

End Sub         

           

Sub test2()    

Range("c1") = "Gagal"          

Range("d1") = "Lulus"         

Range("E2").Formula = "= IF(OR(B2<60, C2<60, D2<60),$C$1,$D$1)"

[E2:E10].Formula = "= IF(OR(B2<60, C2<60, D2<60),$C$1,$D$1)"      

  Application.DisplayFormulaBar = False  

End Sub         

           

17       Application Match                 

            Function Match  Beda Sheet           

           

Sub macth_test1()    

'Menemukan urutan data pada tabel         

'=MATCH(C2,B2:B10,0)       

Range("D2").Formula = "=MATCH(C2,$B$2:$B$10,0)"   

Range("D2:D10").FillDown 

End Sub         

           

Sub macth_test2()    

'Menemukan urutan data pada tabel         

'=MATCH(C2,B2:B10,0)       

 [E2:E10].Formula = "=MATCH(C2,$B$2:$B$10,0)"         

End Sub         

           

18       Application Max        

                       

Sub selection_cell()  

Dim x As Range        

Set x = Selection       

ActiveCell.Offset(0, 1).Value = Application.Max(x)           

End sub         

           

Sub Maksimal()        

Range("E1").Formula = "=max(a1:d1)"     

Range("E1:E10").FillDown  

End Sub         

           

19       Application Min         

                       

Sub min_range()       

Set xx= Sheets("sheet1").Range("A1:A10")           

ActiveSheet.Range("A1") = Application.Min(xx)   

End Sub         

           

20       Application AND       

            Function  Memenuhi syarat beberapa category  

           

Sub test1()    

Range("c1") = "Lulus"          

Range("d1") = "Gagal"         

'Memenuhi syarat beberapa category       

'Lulus( syarat1, syarat2, syarat3)  

'=IF(AND(B2>7,C2>7, D2>7),"LULUS","GAGAL") 

Range("E2").Formula = "=IF(AND(B2>7,C2>7, D2>7),$C$1,$D$1)"      

End Sub