Maaf ada sedikit koreksi yg akhirnya di test ulang . Sub coba()
Range("D8").Select
nilaisebelumnya = Selection.Offset(0, 0)
j = 0
If IsNumeric(Mid(nilaisebelumnya, 2, 1)) Then
Selection.Offset(i, 1) = Left(nilaisebelumnya, 1) &
Mid(nilaisebelumnya, 2, panjang - 1) & "-" & WorksheetFunction.Text(j + 1,
"###")
ElseIf IsNumeric(Mid(nilaisebelumnya, 3, 1)) Then
Selection.Offset(i, 1) = nilaisebelumnya
End If
jumbaris = Range("d8:d27").Rows.Count - 1 For i = 1 To jumbaris
j = j + 1
nilaisekarang = Range("D8").Offset(i, 0)
panjang = Len(nilaisekarang)
If nilaisekarang = nilaisebelumnya Then
If WorksheetFunction.IsText(nilaisebelumnya) Then
If IsNumeric(Mid(nilaisebelumnya, 2, 1)) Then
Selection.Offset(i, 1) = Left(nilaisebelumnya, 1) &
Mid(nilaisebelumnya, 2, panjang - 1) & "-" & WorksheetFunction.Text(j + 1,
"###")
ElseIf IsNumeric(Mid(nilaisebelumnya, 3, 1)) Then
Selection.Offset(i, 1) = Left(nilaisebelumnya, 2) &
WorksheetFunction.Text(Mid(nilaisebelumnya, 3, panjang - 2) + j,
WorksheetFunction.Rept("0", panjang - 2))
End If
Else
MsgBox "aturan lainya"
End If
Else
nilaisebelumnya = nilaisekarang
j = 0
If IsNumeric(Mid(nilaisebelumnya, 2, 1)) Then
Selection.Offset(i, 1) = Left(nilaisebelumnya, 1) &
Mid(nilaisebelumnya, 2, panjang - 1) & "-" & WorksheetFunction.Text(j + 1,
"###")
ElseIf IsNumeric(Mid(nilaisebelumnya, 3, 1)) Then
Selection.Offset(i, 1) = nilaisebelumnya
End If End If
Next iEnd Sub Dan ada hal yang juga cukup mengganggu :di sel D18 terisi :
AA34556, apa seharusnya AA034556 ? karena jika dianggap sama maka perlu kdoing
tambahan ?
'==== sebelumnya
Sub coba()
Range("D8").Select
nilaisebelumnya = Selection.Offset(0, 0)
Selection.Offset(0, 1) = nilaisebelumnya
jumbaris = Range("d8:d27").Rows.Count - 1
j = 1
For i = 1 To jumbaris
nilaisekarang = Range("D8").Offset(i, 0)
panjang = Len(nilaisekarang)
If nilaisekarang = nilaisebelumnya Then
If WorksheetFunction.IsText(nilaisebelumnya) Then
If IsNumeric(Mid(nilaisebelumnya, 2, 1)) Then
' P1234567 maka semua utuh P1234567 & "-" & urut ( 1,2,3,...)
Selection.Offset(i, 1) = Left(nilaisebelumnya, 1) &
nilaisebelumnya & "-" & WorksheetFunction.Text(j + 1, "###")
ElseIf IsNumeric(Mid(nilaisebelumnya, 3, 1)) Then
'AA123456 maka yg diambil 6 digit angka ( 8-2 )
Selection.Offset(i, 1) = Left(nilaisebelumnya, 2) &
WorksheetFunction.Text(Mid(nilaisebelumnya, 3, panjang - 2) + j,
WorksheetFunction.Rept("0", panjang - 2))
End If
Else
MsgBox "aturan lainya"
End If
j = j + 1
Else
nilaisebelumnya = nilaisekarang
Selection.Offset(i, 1) = nilaisekarang
j = 1
End If
Next i
End Sub
To: [email protected]
From: [email protected]
Date: Thu, 20 Oct 2011 09:08:47 +0800
Subject: Fw: [belajar-excel] mengurutkan data
Dear Pa' Hapsari
Mamtab...b
Tapi kayaknya ada yang kurang kalau boleh nambah seperti terlampir
dimana datanya akan semua diurutkan berdasarkan data teratas yang disorot kalau
sekaligus di sorot
padahal patokannya adalah hanya dengan nilai teratas dengan nilai yang sama
kalau sekaligus di sorot semua, tidak perlu yang sama saja
dan sebagai tambahan bagaimana agar angka misalnya 6 digit kalau kurang di
tambah "0" di depang angka
Juga ada penambhan type item yang berbeda
mohon masukannya
Regards,
Gultom
----- Forwarded Message -----
From: Haps <[email protected]>
To: [email protected]
Sent: Wednesday, October 19, 2011 10:16 PM
Subject: Re: [belajar-excel] mengurutkan data
maaf ada salah tulis, di bagian penjelasan baris ke 3 yg bisa menimbulkan
kesulitan menangkap maksud yg disampaikan.
tertulis:
Kelompok-depan namanya Pre (diharapkan berisi karakter-karakater Huruf)
seharusnya:
Kelompok-depan namanya Hrf (diharapkan berisi karakter-karakater Huruf)
terima kasih
2011/10/19 Haps <[email protected]>
"Tunjek" point saja...:
>
>
>Sub Ubah_NrPO()
> ' hapsari / Oct 19, 2011
> ' beExcel Posting# 13632
> '--------------------------
> Dim Nmr As Long, n As Integer
> Dim Hrf As String, Itm As String
>
> Itm = Selection(1, 1)
> For n = Len(Itm) To 1 Step -1
> If Not IsNumeric(Mid(Itm, n, 1)) Then Exit For
> Next
> Hrf = Left(Itm, n)
> Nmr = Val(Right(Itm, Len(Itm) - n))
> For n = 1 To Selection.Rows.Count
> Selection(n, 1) = Hrf & Nmr + n - 1
> Next n
>
>
>End Sub
>
>
>Data pertama di daerah yg disorot (selection) dianggap mewakili semua data
>di bawahnya; data itu kita ingat sbgItm dan kita penggal menjadi dua kelompok.
>Kelompok-depan namanyaPre (diharapkan berisi karakter-karakater Huruf)
>Kelompok belakang namanya Nmr (diharapkan berisi karakter-karakter Numeric)
>
>
>Untuk BISA membagi dua kelompok tsb diperlukan posisi (N) yaitu letak karakter
>HURUF (bukan angka)yg terkanan, untuk keperluan itu diperlukan loop (loop
>pertama)
>yg hanya mengunjungi semua karakter dlm string Itm.
>
>
>Setelah itu dilakukan loop lagi yg mengunjungi semua cell dlm sorotan
>(selection)
>tiap cell yg dikunjungi diisi DATA BARU yaitu gabungan dari Hrf dan Nmr
>tetapi
>setiap stepNmr ditambah dengan nilai Counter (n) dikurangi 1
>
>
>Pantas saja kalau hasilnya sepeti yg diharapkan (mudah-mudahanan sih...)
>
>
>-haps-
>
>
