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]>
<mailto:[email protected]>
*To:* [email protected]
<mailto:[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.
