Nah lo,,,, Kan udah dijelaskan kembali sama mbak ctv, coba dibaca lagi : file yg siti kirim ternyata bukan file yg terakhir di-recheck ada 1 variable yg belum dideklarasikan yaitu string StrItm
Jadi di Seksi 'Declaring Variables' lengkap, seharusnya seperti ini Dim Tbl As Range, NewTbl As Range Dim n As Long, r As Long, i As Long, tR As Long Dim c As Integer, u As Integer Dim StrItm As String, Itm As String StriItm disitu digunakan sebgai tempat menampung KodeGaransi yg pada loop-step SEBELUMnya = tidak ada, sehingga StrItm otomatis berisi Uniq Values) 2011/4/9, ***Jonathan*** <jonathan.susa...@gmail.com>: > > Neng Ctv... > > saya pake excel 2003 > > error terlampir.. > > > > > On 09-04-2011 3:56 AM, STDEV(i) wrote: >> >> kalau tinggal pencet tombol full ostosmastis, bgmana, tidak asik ya... >> >> >> Sub AbnormalizeYourTabel() >> ' siti Vi / milis belajar-excel / 08 apr 2011 >> '------------------------------------------- >> Dim Tbl As Range, NewTbl As Range, Itm As String >> Dim n As Long, r As Long, i As Long, tR As Long >> Dim c As Integer, u As Integer >> Set Tbl = Sheet1.Cells(4, 2).CurrentRegion >> tR = Tbl.Rows.Count >> Set NewTbl = Tbl(tR + 6, 1) >> StrItm = "|" >> Application.Calculation = -4135 'manual >> Application.ScreenUpdating = 0 >> >> ' soal unique values lagi.... >> ' sambil mereconstruk 3 kolom pertama >> For i = 2 To tR >> Itm = Tbl(i, 1) & "|" >> If InStr(1, StrItm, Tbl(i, 1), 1) = 0 Then >> r = r + 1 >> StrItm = StrItm & Itm >> Tbl(i, 1).Resize(1, 3).Copy >> NewTbl(r, 1).PasteSpecial 12 >> End If >> Next i >> Application.CutCopyMode = False >> Set NewTbl = NewTbl.CurrentRegion >> >> ' data yg berulang mulai kolom 4 >> ' berdasarkan uniq item di kolom 1 >> For n = 1 To NewTbl.Rows.Count >> c = 0 >> For i = 2 To tR >> If NewTbl(n, 1) = Tbl(i, 1) Then >> c = c + 2 >> Tbl(i, 4).Resize(1, 2).Copy >> NewTbl(n, 2 + c).PasteSpecial 12 >> End If >> Next i >> Next n >> >> *' membuat Header-nya* >> Tbl.Resize(1, Tbl.Columns.Count - 2).Copy NewTbl(0, 1) >> u = (NewTbl.CurrentRegion.Columns.Count - 1) >> Tbl(1, 4).Resize(1, 2).Copy >> For c = 4 To u Step 2 >> NewTbl(0, c).PasteSpecial xlAll >> Next c >> >> Application.CutCopyMode = False >> Application.Calculation = -4105 'auto >> Application.ScreenUpdating = 1 >> >> End Sub >> >> kok gag ringkas ya... jelex.. >> >> >> >> > > -- Salam, -uhr-
