*koreksi sedikit *untuk mempercepat makro
Loop dihentikan jika variable r sudah > Index
'-----
Function ReptQty(ArrItem As Range, ArrQty As Range, Idx)
' siti Vi / 22 agu 2011
' mengulanga item sebanyak qty
Dim i As Long, n As Long, r As Long, arr()
For i = 1 To ArrItem.Rows.Count
For n = 1 To ArrQty(i, 1)
r = r + 1
If r > Idx Then GoTo Endd
ReDim Preserve arr(1 To r)
arr(r) = ArrItem(i)
Next n
Next i
*Endd:*
ReptQty = arr(Idx)
End Function
'-----
thx / ~siti
2011/8/22 STDEV(i) <[email protected]>
> atau
> kalau keperluan ini sering timbul, bgmana kalau kita buat fungsi dalam
> negeri
> diberi nama ReptQty (mengulang sebanyak Quaitity)
>
> sintaks
> =ReptQty(ArrayItem, ArrayQty, Index)
>
> Praktek di lapangan
> =ReptQty($C$7:$C$11, $D$7:$D$11, F7)
> atau bisa ditambah Validasi mencegahmunculnya err VALUE
> jika data sudah habis
> =IF(F7>SUM($D$7:$D$11),"",ReptQty($C$7:$C$11,$D$7:$D$11,F7))
>
> formula biasa; (bukan array formula) berlaku untuk 1 cell
> tinggal dicopy ke bawah sampai muncul Errofr Value (tanda bahwa array hasil
> sudah habis)
> atau muncul data blank (jika memakai IF sebagai validasi)
>
> semoga ada manfaatnya
>
> - function procedure VBA Code di module standar
>
> *Function ReptQty*(ArrItem As Range, ArrQty As Range, Idx)
> ' siti Vi / 22 agu 2011
> ' mengulanga item sebanyak qty
> Dim i As Long, n As Long, r As Long, Arr()
> For i = 1 To ArrItem.Rows.Count
> For n = 1 To ArrQty(i, 1)
> r = r + 1
> ReDim Preserve Arr(1 To r)
> Arr(r) = ArrItem(i)
> Next n
> Next i
> ReptQty = Arr(Idx)
> *End Function*
> '----------------------
>
>
>
> 2011/8/22 MAMUDA PONTIM <[email protected]>
> > Salam Excel
> > Mohon bantuan para pakar untuk kasus terlampir. Saya ingin mengisi kolom
> berdasarkan data dari tabel berbeda.
> > Misalnya pada tabel sumber tertulis : *Sapu 4*, maka pada tabel hasil
> tertulis *Sapu sebanyak 4 kali* .
> > Lebih jelas di lampiran. Bisa pake fungsi atau makro.
> > Terima kasih.
>
>
