Function Insret(t As Range, x As String, Optional y As String = "") As String
n = t
z = Len(n) - x
Do While z > 0
n = Left(n, z) & y & Right(n, Len(n) - z)
z = z - x
Loop
Insret = n
End Function
Misal A1 = 1234567890
=Insret(A1,5,",") menghasilkan 12,3456,7890
=Insret(A1,3,"/") menghasilkan 1/234/567/890
>semoga bermanfaat
________________________________
From: Mr. Kid <[email protected]>
To: [email protected]
Sent: Sun, May 16, 2010 2:39:45 AM
Subject: Re: [belajar-excel] Menginsert KOMA setiap 5 karakter
Dulu pernah buat penyusun pattern id seperti begini :
Public Function SetPatternBase( sText As String, _
lPanjang As Long, _
Optional sSisip As String = "|") As String
Dim sRes As String
sText = Trim$(sText)
If lPanjang < 1 Then
GoTo TidakValid
ElseIf LenB(sText) = 0 Then
GoTo TidakValid
End If
Do While LenB(sText) > 0
sRes = sRes & Left$(sText, lPanjang) & sSisip
sText = Mid$(sText, lPanjang + 1)
Loop
SetPatternBase = Trim$(Left$( sRes, Len(sRes) - Len(sSisip)) )
Exit Function
TidakValid:
SetPatternBase = sText
End Function
Hanya saja, bisanya selalu baca dari kiri ke kanan. Kemudian ada client yang
butuh basisnya dari sisi kanan (seperti masalah Pak HerrSoe), maka diubah kala
itu menjadi lebih panjang dikit tapi bisa untuk kiri dan kanan, seperti begini :
Public Function SetPattern(sText As String, _
lPanjang As Long, _
Optional sSisip As String = "|", _
Optional sAlign As String = "left", _
Optional bTrim As Boolean = True) As String
Dim lAdd As Long
Dim sRes As String
'trap error input
If bTrim Then
sText = Trim$(sText)
End If
sAlign = LCase$(sAlign)
If lPanjang < 1 Then
GoTo TidakValid
ElseIf LenB(sText) = 0 Then
GoTo TidakValid
ElseIf sAlign <> "left" And sAlign <> "right" Then
GoTo TidakValid
End If
If sAlign = "right" Then
sText = StrReverse(sText)
sSisip = StrReverse(sSisip)
End If
Do While LenB(sText) > 0
sRes = sRes & Left$(sText, lPanjang) & sSisip
sText = Mid$(sText, lPanjang + 1)
Loop
If bTrim Then
sRes = Trim$(Left$( sRes, Len(sRes) - Len(sSisip)) )
Else
sRes = Left$(sRes, Len(sRes) - Len(sSisip))
End If
If sAlign = "right" Then
SetPattern = StrReverse$( sRes)
Else
SetPattern = sRes
End If
Exit Function
TidakValid:
SetPattern = sText
End Function
Untuk kebutuhan standarisasi tampilan kode yang delimiternya menurut aturan
tertentu (tidak konstan selalu berbilang n karakter), maka harus dirombak
kearah penggunaan array, sehingga kode menjadi lebih panjang lagi, tetapi bisa
untuk kiri kanan dan tetap bisa digunakan untuk aturan dengan n karakter
konstan seperti client yang dulu.
Kode programnya seperti ini :
Public Function SetPatternDin( sText As String, _
vPanjang As Variant, _
Optional vSisip As Variant = "|", _
Optional sAlign As String = "left", _
Optional bTrim As Boolean = True) As Variant
Dim vTemp As Variant
Dim lTemp As Long
Dim vPjg As Variant
Dim lPjg As Long
Dim vDelimiter As Variant
Dim lDelimiter As Long
Dim sRes As String
Dim lSisip As Long
Dim bKanan As Boolean
bKanan = False
If bTrim Then
sText = Trim$(sText)
End If
sAlign = LCase$(sAlign)
If IsArray(vPanjang) Then
vPjg = vPanjang
Else
ReDim vPjg(1, 1)
vPjg(1, 1) = vPanjang
End If
lPjg = UBound(vPjg)
If IsArray(vSisip) Then
vDelimiter = vSisip
Else
ReDim vDelimiter(1)
vDelimiter(1) = vSisip
End If
lDelimiter = UBound(vDelimiter)
If lPjg * lDelimiter = 0 Then
GoTo TidakValid
ElseIf LenB(sText) = 0 Then
GoTo TidakValid
ElseIf sAlign <> "left" And sAlign <> "right" Then
GoTo TidakValid
End If
If sAlign = "right" Then
sText = StrReverse(sText)
bKanan = True
End If
lTemp = 0
lSisip = 0
For Each vTemp In vPjg
If LenB(sText) <> 0 Then
If CLng(vTemp) > 0 Then
lTemp = lTemp + 1
If lTemp > lDelimiter Then
lTemp = 1
End If
lSisip = Len(vDelimiter( lTemp))
If bKanan Then
sRes = sRes & Left$(sText, vTemp) & StrReverse(vDelimit
er(lTemp) )
Else
sRes = sRes & Left$(sText, vTemp) & vDelimiter(lTemp)
End If
sText = Mid$(sText, vTemp + 1)
End If
End If
Next vTemp
If bTrim Then
sRes = Trim$(Left$( sRes, Len(sRes) - lSisip))
Else
sRes = Left$(sRes, Len(sRes) - lSisip)
End If
If sAlign = "right" Then
SetPatternDin = StrReverse$( sRes)
Else
SetPatternDin = sRes
End If
Exit Function
TidakValid:
SetPatternDin = sText
End Function
Sampai sekarang, tidak tahu sudah dibetulkan dibagian mana saja, jadi kalau ada
bug, mohon dibetulkan dan di posting ulang ke milis dan terima kasih sebelumnya.
Hanya saja, pada file xls ada peringatan ketika akan di save, maka disertakan
juga versi xlsm (xl2007), karena ini penulisan ulang ke excel dengan
menyesuaikan array pattern length.
Sayangnya, array delimiter tidak bisa merujuk ke ranges. Mungkin ada yang mau
memperbaikinya (hehehe... cari enaknya sendiri)
Regards.
Kid.
2010/5/15 siti Vi <setiyowati.devi@ gmail.com>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
> >
>
>>
>
>>
>
>>
>
>Daripada "pusing formula"
>(atau cell formatting?? ) pakai UDF aja dech ya....
>
>Dengan UDF InsertChar kita dapat bebas
>menenetukan
>**interval antar karakter yg akan disisipkan (dlm pemintaan =
>5)
> dapat
>dibuat bebas, mau 2, mau 8, mau 3 tinggal menuliskan sbg
> argument
>ke 2
>**Karakter yg akan dipakai sebagai PENYISIP /
>separator (yg disisipkan)
> (dlm
>permintaan = KOMA (","), juga dapat anda tentukan sendiri
> misal "/", "|" atau mungkin
>"///" atau "____" terserah saja
>
>Sintaks nya
>=InsertChar( Cell,
>JumlahKarakter, [Karakter_penyisip] )
>misal
>=InsertChar( A1,5,",")
> hasilnya sesuai permintaan HerrSoe:
>00000,12345, 67890,12345
>
>=InsertChar( F16,8,"\\")
> hasilnya bisa spt
>ini xxxxxxxx\\xxxxxxxx\ \xxxxxxxx\ \
>remarks:
>Argument ke 3 (karakter
>penyisip/separator)jika dikosongkan akan dianggap
>KOMA
>Lihat workbook
>(attached)
>
>'------------ -------
>Function
>InsertChar(Xel As Range, N As Byte, _
> Optional
>Separator As String = ",") As
>String
> ' siti Vi / 15 May
>2010
>
> Dim X As String, t As String, s As
>String
> X = Xel.Text
>
>Do
> s = Separator & Right(X,
>N)
> If Len(X) >= N
>Then
> t = s &
>t
>
>Else
> t = X &
>t
> Exit
>Do
> End If
> X
>= Left(X, Len(X) - N)
> Loop
> If Left(t,
>Len(Separator) ) = Separator Then t = Right(t, Len(t) - 1)
>
>InsertChar = t
>End Function
>
>
________________________________
>----- Original Message -----
>>From: HerrSoe
>>To: belajar-excel
>>Sent: Friday, May 14, 2010 11:01 PM
>>Subject: [belajar-excel] Menginsert KOMA
>> setiap 5 karakter>>
>>Dear Group,
>>Bagaimanakah cara termudah untuk memberi KOMA
>> tiap 5 karakter
>>dihitung dari kanan; contohnya seperti ini
>>
>>
>>
>>
>>input (type data:
>> text)
>> output
>> (type data: text)
>>
>>10000023456789012345 00000,12345, 67890,12345
>>0001230004560007890 00321000 00,01230,00456, 00078,90003, 21000
>>formula OKE, UDF juga wellcome..
>>
>>Terima kasih.
