koreksi ketikan: Misal A1 = 1234567890 =Insret(A1,4,",") menghasilkan 12,3456,7890 =Insret(A1,3,"/") menghasilkan 1/234/567/890
>semoga bermanfaat ________________________________ From: anton suryadi <[email protected]> To: [email protected] Sent: Mon, May 17, 2010 1:19:51 PM Subject: Re: [belajar-excel] Menginsert KOMA setiap 5 karakter 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.
