gile...e ketemu aza jalannya padahal semalaman di zikirin ngga ketemu2 Terima kasih banyak boss, walau masih ada yang kurang, mengingat alokasi datanya adalah tidak fix sehingga harus merubah2 cell addressVBA jika mau di run Sebenarnya terjadinya data yang sama adalah karena jumlah data itu tergantung daripada jumlah barang (karena satu PO terdiri dari 1 PO tapi kadang kalau langsung main urutin aza, takut kalau tiba2 loncat jadinya loss kontrol Sementara untuk memisah-misahkan adalah dengan insert row seusai dengan jumlah barang misalnya ada barang 5 dengan po mulai urutan AA34556 maka akan saya insert rownya 4 kemudian saya copas sehingga timbul nomor yang sama
yang ada 0 di depan angka masing2 barang kadang mempunyai digit yang berbeda dengan angka yang rendah Regards, Gultom ----- Forwarded Message ----- From: jkssxls Sudarsono <[email protected]> To: Belajar-Excel Yahoo Groups <[email protected]> Sent: Thursday, October 20, 2011 4:04 PM Subject: RE: [belajar-excel] mengurutkan data Maaf ada sedikit koreksi yg akhirnya di test ulang . Sub coba() jumbaris = Range("d8:d29").Rows.Count - 1 Range("D8").Select nilaisebelumnya = Selection.Offset(0, 0) panjang = Len(nilaisebelumnya) 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 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 i End 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- > >
