Kok belum ada yg menanggapi ya, padahal saya ikut menunggu-nunggu,
seperti apa kira kira sol-usil-nya
Begini saja, kita buat asal-ada saja dulu, nantinya para pakar yg
melihat coding
asal-asalan ini diharapkan bekenan memberi saran dan perbaikan..
Hasil makro ini masih menyisakan pekerjaan yaitu mengisi kolom TrfQty
dan kolom Order Supplier ( Order *kepada *supplier ??/ order *dari*Supplier??)
Kedua data di kolom tsb tidak terlalu sulit dicarinya karena hanya perlu
operasi
aritmatik biasa...
'-----------VBE module standard------------------
Dim Tempe As Range
Dim UniqProdukList
Sub CreateTabelTempe()
*' Create TabelTempe*
*' VBA-coded by indri hapsari / dec 2, 1011*
*' XL-mania case # 19620*
*'-----------------------------------------*
Dim TmpSht As Worksheet, n As Long
Dim Tbl As Range, Produk As Range
Set Tbl = Sheets("Data").Range("A1").CurrentRegion
Tbl(1, 17) = "sign": Tbl(1, 18) = "absQty"
For n = 2 To Tbl.Rows.Count
Tbl(n, 17) = Sgn(Tbl(n, 16).Value)
Tbl(n, 18) = Abs(Tbl(n, 16).Value)
Next n
Set Tbl = Tbl.CurrentRegion
Set TmpSht = Worksheets.Add
Set Tempe = TmpSht.Cells(1)
TmpSht.Name = "Tbl_Tempe"
Tbl.Copy Tempe
Application.CutCopyMode = False
Set Tempe = Tempe.CurrentRegion
* ' menggoreng Tempe (gak pake tepung)*
Tempe.Sort _
Key1:=Tempe(2, 4), Order1:=xlAscending, _
Key2:=Tempe(2, 18), Order2:=xlDescending, _
Header:=xlYes, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, _
DataOption1:=xlSortTextAsNumbers, DataOption2:=xlSortNormal
Range(Tbl(1, 17), Tbl(1, 18)).EntireColumn.Delete
* ' membuat Daftar Produk_ID_Uniq*
Set Produk = Tempe.Offset(1, 3)
Set Produk = Produk.Resize(Produk.Rows.Count - 1, 1)
UniqProdukList = LOUV(Produk)
Tempe.EntireColumn.AutoFit
End Sub
Sub SusunReport()
* ' Generate Report based on TabelTempe*
* ' VBA-coded by indri hapsari / dec 2, 1011*
* ' XL-mania case # 19620*
* '-----------------------------------------*
Dim Report As Range, Urutan
Dim n As Long, i As Long, r As Long
Dim r1 As Long, r2 As Long, c As Integer
Dim AccuPlus As Double, AccuMinus As Double
Urutan = Array(1, 11, 13, 14, 12, 16)
Set Report = Sheets("hasil").Cells(1).CurrentRegion
Set Report = Report.Offset(2, 0)
* ' report lama dihapus dulu Oom...*
Report.ClearContents
* ' menyusun report baru*
For i = 1 To UBound(UniqProdukList)
r = WorksheetFunction.Max(r1, r2)
r1 = r: r2 = r
For n = 2 To Tempe.Rows.Count
If Tempe(n, 4) = UniqProdukList(i) Then
If Tempe(n, 17) < 1 Then
r2 = r2 + 1
Report(r2, 1) = Tempe(n, 4)
Report(r2, 2) = Tempe(n, 5)
For c = 0 To 5
Report(r2, 9 + c) = Tempe(n, Urutan(c))
Next c
AccuMinus = AccuMinus + Tempe(n, 16)
ElseIf Tempe(n, 17) = 1 Then
r1 = r1 + 1
Report(r1, 1) = Tempe(n, 4)
Report(r1, 2) = Tempe(n, 5)
For c = 0 To 5
Report(r1, 3 + c) = Tempe(n, Urutan(c))
Next c
AccuPlus = AccuPlus + Tempe(n, 16)
End If
End If
Next n
Next i
Sheets(Report.Parent.Name).Activate
End Sub
' -------------------------------------
Variable AccuMinus (akumulasi nilai Minus) dan AccuPlus (akumulasi nilai
plus) sudah disiapan
tetapi belum digunakan..
Contoh workbook lengkap [distribusi stock ( haps makro - beta
version).xlsm<http://www.box.com/s/cmm2460b9n00jnx9dd8t>]
dapat diintip &
diunduh di: http://www.box.com/s/cmm2460b9n00jnx9dd8t
--
2011/11/28 ATek Hoe <[email protected]>
>
> Dear teman milisers
> Mohon bantuan teman2 ya. TQ
> Saya diberi tugas utk membuat report Excel berupa distribusi stock dari
outlet yg overstock ke outlet yg stocknya kekurangan/minus.
> Datanya sy query dari table mySQL dgn beberapa parameter dan simpan ke
sheet DATA
> Pd kolom STATUSQTY, positif = overstock ( endqty>maxqty),
> nol = ideal ( minqty<=endqty<=maxqty), minus = kekurangan ( endqty<minqty
)
>
> Rulesnya:
> 1. Pilih outlet yg STATUSQTY positifnya paling besar dan minus terbanyak
> 2. Pindahkan dari Status Positif terbesar ke Status Minus terbesar
> a. Bila Statusqty Positif < Minus, pilih outlet berikutnya yg Statusqty
terbesar ke 2, dst
> (*) Bila tidak ada lagi outlet yg StatusQty positif, isi kolom ORDER
dari supplier utk outlet yg StatusQtynya masih minus.
> b. Bila Statusqty Positif > Minus, ulangi kembali mulai dari rule no 1
>
> Sy sdh coba sekitar 2 minggu tapi belum berhasil jg. Belum begitu lama
belajar VBA, Cuma ngerti sedikit. Array msh belum paham benar.
> Mohon bantuan teman2, lg dikejar2 boss ..he.eh.e
> TIA
> Atek
> nb: sheet Hasil adalah contoh yg diinginkan
