Masih melanjutkan posting sebelumnya
sekarang saya mo ceriwis tentang: Cara Lain menampilkan data
maupun cara lain meng-Expresikan algoritma kedalam coding.
1. jika data ingin dihasilkan tanpa array formula
1.a.
semua hasil diitampilkan dalam 1 (satu cell)
misal data tertulis di cell A1 = "100SEV50"
formula biasa, dgn memanfaatkan fungsi (UDF) GroupNumText
=GroupNumText(A1, " - ")
menghasilkan "100 - SEV - 50"
1.b.
setiap cell menampilkan satu hasil
misal data = "100SEV50"
formula biasa, dgn memanfaatkan fungsi (UDF) GroupNumText
=SeparateNumtext($A1,1)
=SeparateNumtext($A1,2)
=SeparateNumtext($A1,3)
menghasilkan 3 data di 3 cell
"100"
"SEV"
"50"
1. jika data ingin dihasilkan dengan array formula
array formula ditulis di 3 cells sebaris
{=SplitNumText(A1)}
menghasilkan 3 data di 3 cell
"100"
"SEV"
"50"
ketiga Fungsi tsb ( GroupNumText, SeparateNumText dan SplitNumText )
adalah FBD (fungsi buatan dèwèk) yg merupakan peringkasan code dan pengembangan fitur
dari UDF yg kemarin sudah diposted
Contoh penggunaan ada di workbook terlampir.
Berikut ini listing code yg diberi beberapa comments agar (bagi yg berminat) mudah
mengikuti maksud tiap kalimat codenya
Tantangannya masih sama, yaitu: How To: membedakan
SEKELOMPOK karakter yg ANGKA SEMUA -vs - SEKELOMPOK karakter yg HURUF SEMUA
sedangkan kondisi data-awal = semua karakter ngumpul jadi 1 string tanpa tanda pemisah
'------ 1 -------
Function GroupNumText(Cel As Range, Optional Delimiter As String = ";")
'--------------------------------------------
' siti Vi / 14 aug 2010 / milis XL-maniak
'--------------------------------------------
' memisah grup angka vs grup huruf (versi 1)
' hasil berupa 1 (satu) data text / dlm 1 cell
' misal Data awal = "ABC123DEF456"
' hasil = "ABC;123;DEF;456"
'--------------------------------------------
Dim TxHasil As String ' penampung hasil kata demi kata
Dim dWord As String ' penampung karakter yg sejenis menjadi se-grup (kata)
Dim Str As String ' nilai string cell yg dirujuk
Dim Ka As String ' Karakter yg sedang di-raba dlm Loop i
Dim Kx As String ' Karakter SEBELUM karakter ke i
Dim KaType As Boolean ' Apakah Ka = Angka ?
Dim KxType As Boolean ' Apakah Kx = Angka ?
Dim i As Integer ' counter (pencacah Loop)
Const Angka As String = "0123456789" 'rujukan pembanding karakter ke i
Str = Trim(Cel.Text) & " "
'Loop semua karakter dlm data kalimat
For i = 1 To Len(Str)
' Ka mewakili karakter yg sedang diraba (karakter ke i)
Ka = Mid(Str, i, 1)
' Kx mulai dicari setelah i > 1 (bernilai 2 dst..)
If i > 1 Then Kx = Mid(Str, i - 1, 1) Else Kx = Ka
' mencatat Type Ka dan Kx (bisa True bisa False)
KaType = InStr(1, "0123456789", Ka) > 0
KxType = InStr(1, "0123456789", Kx) > 0
If KaType = KxType Then 'jika type-nya sama
dWord = dWord & Ka ' karakter ditampung ke dlm dWord
If i = Len(Str) Then TxHasil = TxHasil & Trim(dWord) & Delimiter
Else ' Jika type tidak sama
' dWord di rangkai dng dWord yg sudah ada
' tetapi diberi tanda pemisah,
' lalu dicatat di variable TxHasil
TxHasil = TxHasil & Trim(dWord) & Delimiter
' jangan lupa mengosongkan Nilai dWord
dWord = ""
' dWord mulai lagi menampung karakter yg sedang diproses
dWord = dWord & Ka
End If
Next i
' Delimiter terkanan dibuang dari text-hasil-akhir
' sambil ditampung ke variable NamaFungsi
GroupNumText = Left(TxHasil, Len(TxHasil) - Len(Delimiter))
End Function
'------ 2 -------
Public Function SeparateNumText(Str As String, Optional Idx As Integer = 1)
'--------------------------------------------
' siti Vi / 14 aug 2010 / milis XL-maniak
'--------------------------------------------
' memisah grup ANK vs grup huruf (versi 2)
' syntak di worksheet
' =SeparateNumText(cell/text, AngkaBulat)
'--------------------------------------------
Dim TxArr() ' As String
Dim W As String
Dim Ka As String
Dim Kx As String
Dim i As Integer
Dim n As Integer
Const ANK As String = "0123456789"
Str = Trim(Str) & " "
For i = 1 To Len(Str)
Ka = Mid(Str, i, 1)
If i > 1 Then Kx = Mid(Str, i - 1, 1) Else Kx = Ka
' jika Jenis Ka SAMA-DENGAN Jenis Kx
If (InStr(1, ANK, Ka) > 0) = (InStr(1, ANK, Kx) > 0) Then
W = W & Ka
' hanya jika i adalah perulangan terakhir
If i = Len(Str) Then
' 1 Elemen Array diisi dengan data W yg di-Trim
n = n + 1: ReDim Preserve TxArr(1 To n)
TxArr(n) = Trim(W)
End If
Else ' (IF Ka Type <> Kx Type)
' 1 Elemen Array diisi dengan data W yg di-Trim
n = n + 1: ReDim Preserve TxArr(1 To n)
TxArr(n) = Trim(W)
W = "": W = W & Ka
' IF di bawah ini = untuk mempersingkat loop
' pengisian Array TxArr ndak ferlu dilanjutkan
' bila banyaknya elemen array sudah = Idx (Index)
If n = Idx Then Exit For
End If
Next i
' hasil akhir hanya mengambil satu elemen array
' yaitu elemen ke sekian (sekian-nya = Idx)
SeparateNumText = TxArr(Idx)
End Function
'------ 3 -------
Public Function SplitNumText(Str As String)
'-------------------------------------------------------
' siti Vi / 14 aug 2010 / milis XL-maniak
'-------------------------------------------------------
' untuk di bandingkan dengan UDF SeparateNumberByText posting sebelumnya
' memisah grup angka vs grup huruf (versi 3)
' bila grup ternyata > 1, fungsi ini menghasilkan Array
' o.k.i. di worksheet harus dituliskan sbg Array Formula
' sekaligus dalam BEBERAPA CELLS sebaris
'-------------------------------------------------------
Dim TxArr() As String
Dim W As String, Ka As String, Kx As String
Dim i As Integer
Dim n As Integer ' =pencacah elemen pada Dynamic-Array TxArr
Str = Trim(Str) & " "
For i = 1 To Len(Str)
Ka = Mid(Str, i, 1)
If i > 1 Then Kx = Mid(Str, i - 1, 1) Else Kx = Ka
If (InStr(1, "0123456789", Ka) > 0) = _
(InStr(1, "0123456789", Kx) > 0) Then
W = W & Ka
If i = Len(Str) Then
n = n + 1
ReDim Preserve TxArr(1 To n)
TxArr(n) = Trim(W)
End If
Else
n = n + 1
ReDim Preserve TxArr(1 To n)
TxArr(n) = Trim(W)
W = "": W = W & Ka
End If
Next i
SplitNumText = TxArr
End Function
'----------------
cukup ditulis rumus seperti ini
cara 1 (array formula) menghasilkan BEBERAPA CELL sebaris
ARRAY FORMULA ditulis sekaligus dlm beberapa cell sebaris
=SeparateNumberByText(C3)
cara2 (formula biasa) menghasilkan 1 cell berisi data yg sudah diberi tanda pemisah " - "
FORMULA biasa (ndak fake telor)
=PisahkanDong(C3)
'------------ listing code UDF / module 1-----------
Public Function SeparateNumberByText(Str As String)
' siti Vi / 14 aug 2010 / milis XL-maniak
' salah satu trick How To: membedakan
' SEKELOMPOK karakter yg ANGKA SEMUA -vs -
' SEKELOMPOK karakter yang HURUF SEMUA
' sedangkan kondisi data = semua karakter ngumpul jadi 1 string tanpa tanda pemisah
Dim TxArr() As String, ka As String, kx As String
Dim W As String, jka As String, jkx As String
Dim i As Integer, j As Integer
Str = Trim(Str) & " "
For i = 1 To Len(Str)
ka = Mid(Str, i, 1)
If i > 1 Then kx = Mid(Str, i - 1, 1) Else kx = ka
If InStr(1, "0123456789", ka) Then jka = "angka" Else jka = "huruf"
If InStr(1, "0123456789", kx) Then jkx = "angka" Else jkx = "huruf"
If jka = jkx Then
W = W & ka
If i = Len(Str) Then
j = j + 1
ReDim Preserve TxArr(1 To j)
TxArr(j) = Trim(W)
End If
Else ' (IF jka <> jkx)
j = j + 1
ReDim Preserve TxArr(1 To j)
TxArr(j) = Trim(W)
W = ""
W = W & ka
End If
Next i
SeparateNumberByText = TxArr
End Function
'---- end of procedure --------
2010/8/13 Barry <barry.allen@ymail.com>
> Dear Master XL,
> mau tanya soalnya ada kasus di kantor dengan contoh data
>
> 100SEV50
> 10SEV5
> SEV5
> 8TL100
> 6TL5
> dst..
> Agar menjadi
> 100SEV50 menjadi 100 - SEV - 50
> 6TL5 menjadi 6 - TL - 5
> dst..
> nach bagaimana caranya supaya memisahkan angka huruf kemudian angka langi
> pada kolom sebelahnya?? mohon bantuan para Master.
> Dan saya ucapkan terima kasih sebelumnya.
| selamat menunaikan ibadah puasa... walau perut lapar, tanya excel |
| jalan terus... malu bertanya telat pulang kantor :D :D :D |
| http://www.facebook.com/group.php?gid=37671048001&ref=mf |
+-------------------------------------------------------------------+
| DILARANG : MLM, money game, OOT, iklan tanpa izin, SARA, testing, |
| pembicaraan pribadi, one line message, melecehkan, tidak sopan. |
+-------------------------------------------------------------------+
| Buat subjek yang kreatif, jangan : "tanya", "help", "mohon bantu" |
| Usahakan besar attachment < 200 kb. Gunakan winzip jika perlu. |
+-------------------------------------------------------------------+
| Ajak teman-teman Anda bergabung dengan mengirim e-mail kosong ke |
| XL-mania-subscribe@yahoogroups.com atau kirimkan mereka file dari |
| http://groups.yahoo.com/group/XL-mania/files/Promotion/ |
+-------------------------------------------------------------------+
| Berikan testimoni di : http://www.friendster.com/xlmania atau... |
| http://www.xl-mania.com/2008/06/testimoni-xl-mania.html |
+-------------------------------------------------------------------+
| Message lama ada di : |
| http://groups.yahoo.com/group/XL-mania/messages [perlu yahoo id] |
| http://www.mail-archive.com/xl-mania@yahoogroups.com |
+-------------------------------------------------------------------+
Nenhum comentário:
Postar um comentário