Terima kasih pak De. Salam, HK
Sent from Samsung MobileDe Premor <[email protected]> wrote:Bukan Pak HK, new collection itu ya buat nyimpen2 koleksi ajah, nah enaknya si koleksi ini, dia tidak mau diisi nilai key yang sama, kalau sudah ada dia akan error, makanya diatasnya diberi bumbu On Error Resume Next Disitu saya langsung declare menggunakan tag "New" biar nga usah repot2 nanti dibawahnya ngeset lagi menjadi New Collection, karena toh keperluannya cuman sekali itu doank penggunaannya. On 02-10-2013 23:45, hendrik karnadi wrote: Terima kasih Pak De atas codesnya yang begitu singkat dan jelas. Ada 2 kombinasi yang "sangat indah": - On Error Resume Next ..... dan - cKode.Add Trim(Rng), CStr(Rng) Ada yang ingin saya tanyakan mengenai Dim cKode As New Collection. Apakah New Collection merupakan Array untuk numbers ? Salam, HK From: De Premor <[email protected]> To: [email protected] Sent: Wednesday, 2 October 2013, 22:37 Subject: Re: [belajar-excel] Langsung masuk ke sheet yang diinginkan Ikutan urun rembug :D Sub Masukin() Dim SrcData As Range, Rng As Range Dim cKode As New Collection Dim LRow As Long Application.ScreenUpdating = False Set SrcData = Sheet1.Range("D3", Sheet1.Range("D3").End(xlDown)) On Error Resume Next For Each Rng In SrcData cKode.Add Trim(Rng), CStr(Rng) Next For LRow = 1 To cKode.Count Set Rng = SrcData.CurrentRegion.Offset(1, 1).Resize(SrcData.Rows.Count - 1, 2) SrcData.CurrentRegion.AutoFilter Field:=4, Criteria1:=cKode.Item(LRow) Rng.SpecialCells(xlCellTypeVisible).Copy Sheets(cKode.Item(LRow)).Range("B3") SrcData.CurrentRegion.AutoFilter Next Application.ScreenUpdating = True End Sub On 02-10-2013 17:27, hendrik karnadi wrote: Jawaban terlampir menggunakan macro warisan si Mbah dengan modifikasi sana sini. Angka2 (kelompok) 1,2,3,4,5 yang ada pada data maupun nama sheet terpaksa saya ganti menjadi jenis biaya yang ada pada Range("A1") masing2 sheet. Hal tersebut saya lakukan karena fungsi Instr yang dipakai untuk membuat Array Unique Values membutuhkan data string bukan angka Macronya adalah spt ini: Sub splittable() ' siti Vi (updated by Hendrik) ' declarations of variables Dim RefTbl As Range Dim sNames As String, ArrNames Dim r As Long, n As Long, i As Long ' turn off dialoque ' freezing the screen Application.DisplayAlerts = False Application.ScreenUpdating = False ' setting data reference Set RefTbl = Sheets("Sheet1").Range("B3", Range("B3").End(xlDown)) Set RefTbl = RefTbl.Resize(RefTbl.Rows.Count - 1, 3) ' creating unique list of Names For r = 1 To RefTbl.Rows.Count If InStr(1, sNames, RefTbl(r, 3) & "|") = 0 Then sNames = sNames & RefTbl(r, 3) & "|" End If Next ArrNames = Split(sNames, "|") ' split the data For i = LBound(ArrNames) To UBound(ArrNames) - 1 Sheets(ArrNames(i)).Select n = 2 For r = 1 To RefTbl.Rows.Count If RefTbl(r, 3) = ArrNames(i) Then n = n + 1 RefTbl(r, 1).Resize(1, 2).Copy Cells(n, 2).PasteSpecial xlPasteValuesAndNumberFormats End If Next r Application.CutCopyMode = False Next i ' turn on dialoque ' unfreezing the screen Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub Pertanyaannya; Bagaimanakah penulisan macro untuk mendapatkan Array Unique Values yang berupa angka ? Terima kasih. Salam, HK From: Topenk Baday <[email protected]> To: [email protected] Sent: Wednesday, 2 October 2013, 10:10 Subject: [belajar-excel] Langsung masuk ke sheet yang diinginkan [1 Attachment] Dimohon bantuannya, Kami lampirkan contoh permasalahan, Mohon "rumus excel atau makro"-nya supaya data yang diinginkan dapat masuk langsung sesuai dengan kode yang diinginkan. Terima kasih sebelumnya.
