Terima kasih atas bantuannya Mas Puthut, namun otak ini sudah cukup berumur
untuk belajar VBA rada sulit apalagi kalau belajar sendiri. Sebetulnya ingin
sekali belajar, kira-kira ada rekomendasi buku yang cukup lengkap & mudah
dipelajari dari gramedia nggak buat belajar VBA atau macro.
-------------------------------------------------------------
Puthut Wibowo
2009-10-15 21:14:59
belajar-excel
º
Re: [belajar-excel] Rekap data
Om om om...bikinya jangan di jadiin Pipot Tabel Berat oomm ........mending pake
VBA aja oom, . :
Logika nya kayak gini oom :
Cari KodePO yang Unik dari Master Data
Pisahkan semua KodePO Berdasarkan Kode PO yang Unik dari Master Data
dan Tampilkan di ShitBaru 1 Kode PO satu Tabel
Kodingannya kayak gini ooomm.......(File Terlampir...Srikiti Makronya oom 'LoW'
)
Option Explicit
Dim InputSheet As Worksheet
Dim wShitHasilAkhir As Worksheet
Dim x As Variant
Dim y As Variant
Dim r As Long
Dim txtValidasi As String
Dim vCountHasilAkhir As Long
Dim BarisTerakhir, vBarisAkhirHeader As Long
Dim wShitMaster As Worksheet
Dim wShitSementara As Worksheet
Dim vJumlahBaris As Long
Dim i As Long
Dim Countkolom As Long
Sub EnakOOm()
Application.ScreenUpdating = False
Set wShitMaster = Worksheets("MASTER DATA") ' Set Master Data pada sheet 10
BarisTerakhir = wShitMaster.Range("A" & Rows.Count).End(xlUp).Row ' Nilai
Looping
Set wShitSementara = Worksheets.Add
' Kopi data dengan kriteria UNIQUE
wShitMaster.Range("B1:B" & BarisTerakhir).AdvancedFilter
Action:=xlFilterCopy, CopyToRange:=wShitSementara.Range("A1"), Unique:=True
vJumlahBaris = wShitSementara.Range("B" & Rows.Count).End(xlUp).Row
' Loop dan kopi ke range baru
For i = 2 To vJumlahBaris
wShitMaster.Rows("1:" & BarisTerakhir).AdvancedFilter
Action:=xlFilterCopy, CriteriaRange:=wShitSementara.Range("A1:A2"), _
CopyToRange:=Worksheets(wShitSementara.Range("A2").Value).Range("A2"),
Unique:=False
wShitSementara.Rows(2).Delete
Next i
Set InputSheet = Worksheets("MASTER DATA")
Set wShitHasilAkhir = Worksheets.Add(after:=Worksheets(Sheets.Count))
wShitSementara.Activate
vCountHasilAkhir = 3
BarisTerakhir = InputSheet.Range("A" & Rows.Count).End(xlUp).Row
r = 2
' Loop sampai dengan Cell kosong
Do While Cells(r, 1) <> ""
' Set Uniqe Nomor PO
txtValidasi = wShitSementara.Cells(r, 1)
' Masukan Header Kolom Tabel
For Countkolom = 1 To 7
wShitHasilAkhir.Cells(vCountHasilAkhir - 2, "A") = txtValidasi
wShitHasilAkhir.Cells(vCountHasilAkhir - 1, Countkolom) =
InputSheet.Cells(1, Countkolom)
wShitHasilAkhir.Cells(vCountHasilAkhir - 1, Countkolom).Font.Bold =
True
wShitHasilAkhir.Cells(vCountHasilAkhir - 1,
Countkolom).Interior.ColorIndex = 36
Next Countkolom
' Masukan Data Ke item
For i = 2 To BarisTerakhir
If txtValidasi = InputSheet.Cells(i, 2) Then
wShitHasilAkhir.Cells(vCountHasilAkhir, 1) =
InputSheet.Cells(i, 1)
wShitHasilAkhir.Cells(vCountHasilAkhir, 2) =
InputSheet.Cells(i, 2)
wShitHasilAkhir.Cells(vCountHasilAkhir, 3) =
Format(InputSheet.Cells(i, 3), "dd/mm/yyyy")
wShitHasilAkhir.Cells(vCountHasilAkhir, 4) =
InputSheet.Cells(i, 4)
wShitHasilAkhir.Cells(vCountHasilAkhir, 5) =
InputSheet.Cells(i, 5)
wShitHasilAkhir.Cells(vCountHasilAkhir, 6) =
InputSheet.Cells(i, 6)
wShitHasilAkhir.Cells(vCountHasilAkhir, 7) =
InputSheet.Cells(i, 7)
vCountHasilAkhir = vCountHasilAkhir + 1
End If
Next i
vBarisAkhirHeader = wShitHasilAkhir.Range("A" &
Rows.Count).End(xlUp).Row
vCountHasilAkhir = vCountHasilAkhir + 2
r = r + 1
Loop
' Hapus Work Shit sementara -------------
Application.DisplayAlerts = False
wShitSementara.Delete
Application.DisplayAlerts = True
' ---------------------------------------
wShitHasilAkhir.Columns("A:G").AutoFit ' Autofit Hasil Tabel
Application.ScreenUpdating = True
wShitHasilAkhir.Activate
End Sub
--------------------------------------------------------------------------------------------
* Note: Dibuat dan Diuji menggunakan ommXL2003 .....
- ^ Puthut Wibowo ^ -
--- On Thu, 10/15/09, hasna <hasn...@gmail.com> wrote:
From: hasna <hasn...@gmail.com>
Subject: [belajar-excel] Rekap data
To: "belajar-excel" <belajar-excel@yahoogroups.com>
Date: Thursday, October 15, 2009, 4:34 PM
Yth Mas & Mbak,
Maaf tadi ketinggalan filenya.
Mohon bantuannya untuk memecahkan permasalahan saya, begini saya punya
data seperti contoh terlampir dan akan direkap sesuai dengan nomor Ordernya
masing-masing secara otomatis urut berdasarkan tgl dengan menggunakan formula
yang kira-kira tidak terlalu berat karena data tersebut cukup banyak. kalau
menggunakan tabel pivot data memang kelihatan mudah tapi saya menginginkan
dengan memakai formula yang memungkinkan antara data & rekap terpisah filenya.
terima kasih sebelumnya.
Teguh PA
------------ --------- ----
te...@toppan. co.id
