Conversi Angka ke Abajat - Excel VBA

Function ColumnLetter(ColumnNumber As Long) As String

Dim n As Long

Dim c As Byte

Dim s As String

n = ColumnNumber

Do

c = ((n - 1) Mod 26)

s = Chr(c + 65) & s

n = (n - c) \ 26

Loop While n > 0

 ColumnLetter = s

End Function

cara menggunakan 

= ColumnLetter (a1)

silahkan mencoba

Function getColIndex(sColRef As String) As Long

  Dim sum As Long, iRefLen As Long

  sum = 0: iRefLen = Len(sColRef)

  For i = iRefLen To 1 Step -1

    sum = sum + Base26(Mid(sColRef, i)) * 26 ^ (iRefLen - i)

  Next

  getColIndex = sum

End Function

Private Function Base26(sLetter As String) As Long

  Base26 = Asc(UCase(sLetter)) - 64 'fixed

End Function

cara menggunakan 

=getColIndex(a1)


Demikian contoh fungsi vba silahkan dikembangkan
 semoga bermanfaat !!!

Concatenate Multy Coloumn - vba excel

'Gabung text data kolom A1 sampai P1
‘R1 hasil gabungan text disimpan

Sub Concatenate_MultyColom ()
Sub ConcatenateRange()
Sheets("SHEET1").Range("R1:R20").Value = ""
Dim val As String
Dim iLastRow As Long
Dim iLastCol As Long
Dim i As Long
Dim j As Long
iLastRow = Cells.Find(What:="*", _
After:=Range("P1"), _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
For i = 1 To iLastRow
iLastCol = Cells(i, Columns.Count).End(xlToLeft).Column
val = ""
For j = 2 To iLastCol
val = val & Cells(i, j)
Next j
Cells(i, "R").Value = val
Next i
End Sub

Menggabungkan beberapa cell - Celection Cell Concatenate vba

Sub gabungCells()

Dim ColFirst As Long

  Dim ColLast As Long

  Dim GabungKata As String

  Dim RowCrnt As Long

  Dim RowFirst As Long

  Dim RowLast As Long

RowFirst = Selection.Row

  RowLast = RowFirst + Selection.Rows.Count - 1

  ColFirst = Selection.Column

  ColLast = ColFirst + Selection.Columns.Count - 1

  If ColFirst <> 1 Or ColLast <> 1 Then

    Call MsgBox("Please select a range within column ""A""", vbOKOnly)

    Exit Sub

  End If

With Worksheets("sheet1")

    GabungKata = .Cells(RowFirst, "A").Value

    For RowCrnt = RowFirst + 1 To RowLast

      GabungKata = GabungKata & "   " & .Cells(RowCrnt, "A").Value

    Next

    Range("b2").Value = GabungKata

End With

End Sub

PISAH KALIMAT DENGAN ACUAN SEBUAH KARAKTER - EXCEL VBA

NO DAN JENIS JENIS KARAKTER

Pisahkan kalimat to kolom dengan acuan karakter spasi (32 char) 

Posisi diawali pada Baris Ke 2 pada kolom A 

Pastekan kode berikut Pada sebuah modul

Sub Kalimat_kata_dgn_spasi()

Dim var As Variant

Dim rw As Long

With Worksheets("Sheet1")

For rw = 2 To .Cells(.Rows.Count, "A").End(xlUp).Row

If CBool(Len(.Cells(rw, "A").Value2)) Then

var = Split(.Cells(rw, "A").Value2, Chr(32))

 .Cells(rw, "B").Resize(1, UBound(var) + 1) = var

 End If

 Next rw

End With

 End Sub

 Pisahkan kalimat to kolom dengan acuan karakter garis miring (42 char) 

Posisi diawali pada Baris Ke 2 pada kolom A 

Pastekan kode berikut Pada sebuah modul

Sub Kalimat_kata_dgn_garisMiring()

Dim var As Variant

Dim rw As Long

With Worksheets("Sheet1")

For rw = 2 To .Cells(.Rows.Count, "A").End(xlUp).Row

If CBool(Len(.Cells(rw, "A").Value2)) Then

var = Split(.Cells(rw, "A").Value2, Chr(47))

 .Cells(rw, "B").Resize(1, UBound(var) + 1) = var

 End If

 Next rw

End With

 End Sub

Demikian semoga bermanfaat !!

MEMISAHKAN DAN MENGGABUNGKAN TEMPAT DAN TANGGAL LAHIR - RUMUS EXCEL

RUMUS MENGGABUNGKAN       

=C4&", "&TEXT(D4," [$-421]dd mmmm yyyy;@")

RUMUS MEMISAHKAN

                  

          =LEFT(C4,FIND(",",C4)-1) 

          =MID(C4,FIND(",",C4)+2,LEN(C4))    

                  

FUNGSI TERBILANG TANPA ADD IN TERBILANG- EXCEL VBA

PASTEKAN KODE BERIKUT PADA SEBUAH MODUL :
Function Terbilang(n As Long) As String 
'max 2.147.483.647

Dim satuan As Variant, Minus As Boolean
On Error GoTo terbilang_error
satuan = Array("", "Satu", "Dua", "Tiga", "Empat", "Lima", "Enam", "Tujuh", "Delapan", "Sembilan", "Sepuluh", "Sebelas")
If n < 0 Then
Minus = True
n = n * -1
End If
Select Case n
Case 0 To 11
Terbilang = " " + satuan(Fix(n))
Case 12 To 19
Terbilang = Terbilang(n Mod 10) + " Belas"
Case 20 To 99
Terbilang = Terbilang(Fix(n / 10)) + " Puluh" + Terbilang(n Mod 10)
Case 100 To 199
Terbilang = " Seratus" + Terbilang(n - 100)
Case 200 To 999
Terbilang = Terbilang(Fix(n / 100)) + " Ratus" + Terbilang(n Mod 100)
Case 1000 To 1999
Terbilang = " Seribu" + Terbilang(n - 1000)
Case 2000 To 999999
Terbilang = Terbilang(Fix(n / 1000)) + " Ribu" + Terbilang(n Mod 1000)
Case 1000000 To 999999999
Terbilang = Terbilang(Fix(n / 1000000)) + " Juta" + Terbilang(n Mod 1000000)
Case Else
Terbilang = Terbilang(Fix(n / 1000000000)) + " Milyar" + Terbilang(n Mod 1000000000)
End Select
If Minus = True Then
Terbilang = "Minus" + Terbilang
End If
Exit Function
terbilang_error:
MsgBox Err.Description, vbCritical, "^_^Terbilang Error"
End Function

CARA PAKAINYA  : 

 = TERBILANG(B5)&"Rupiah "

Silahkan Mencoba !!!

MEMISAHKAN KATA MENJADI HURUP - EXCEL VBA

BELAJAR EXCEL VBA "CARA MUDAH MEMISAHKAN KATA MENJADI HURUP "

Pastekan kode berikut pada sebuah Modul

Sub Pisah_HURUP()
Baris = 2
For a = 2 To 23
    Kata = Replace(Cells(Baris, 1), " ", "")
    PISAH = Len(Kata)
    Kolom = 2
For i = 1 To PISAH
    b = Mid(Kata, i, 1)
    Cells(Baris, Kolom) = b
    Kolom = Kolom + 1
Next
Baris = Baris + 1
Next
End Sub

Demikian silahkan mencoba !
Semoga bermanfaat !!