RE: ]] XL-mania [[ Cara cepat mencari part number baru ?

Sub UpdateHarga()
Dim dOld As Range ' =tabel daftar harga
Dim dNew As Range ' =tabel perubahan harga
Dim NewTbl As Range ' =tabel baru / hasil
Dim oRow As Long ' =jumRecord pada Daftar Harga
Dim nRow As Long ' =jumRecord pada Perubahan Harga
Dim staHarga As String ' =status naik/turun harga
Dim NewItemFound As Boolean '=flag penanda item baru
Dim r As Long, n As Long '=counter /pencacah looping

'---Setting "Calculation di manualkan,
' (biar ndak ngganggu kerjaan...)
Application.Calculation = xlCalculationManual
'---"Mbikin" sheet barooo, bwat nampung hasil olahan
Worksheets.Add After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = "Daftar Harga Baru_" & CStr(Worksheets.Count)
'---Menentukan Letak Awal Tabel Hasil
Set NewTbl = ActiveSheet.Range("A2")
'---Menentukan Letak Tabel Harga (lama)
Set dOld = Sheets("Daftar_Harga").Range("A1").CurrentRegion.Offset(1, 0)
oRow = dOld.Rows.Count - 1
Set dOld = dOld.Resize(oRow, dOld.Columns.Count)
dOld(0, 1).Resize(1, dOld.Columns.Count).Copy NewTbl(0, 1)
'---Menentukan Letak Tabel PerubahanHarga (baru)
Set dNew = Workbooks("perubahan Harga.xls").Sheets("Perubahan_Harga") _
.Range("A1").CurrentRegion.Offset(1, 0)
nRow = dNew.Rows.Count - 1
Set dNew = dNew.Resize(nRow, dNew.Columns.Count)

'--loop mengunjungi baris-data (records) pada tbl harga baru
For n = 1 To nRow
'--setiYap records yg ada di salin ke Tabel hasil
dNew(n, 1).Resize(1, dOld.Columns.Count).Copy NewTbl(n, 1)
'--kolom ke 6 diisi data Date tgl hari ini
NewTbl(n, 6) = Format(Date, "dd-mmm-yy")
'--Re-Init : flag NewItemFound
NewItemFound = False
' loop: kunjungan ke tiap baris-data pada TabelHargaLama
For r = 1 To oRow
'--Kalau field 1 di TblHargaLama = TblHargaBaru
If dOld(r, 1) = dNew(n, 1) Then
'--status NewItem = Found
NewItemFound = True
'--status Harga dituliskan (di field 5)
NewTbl(n, 4) = dOld(r, 3)
If dOld(r, 3) < dNew(n, 3) Then staHarga = "Naik"
If dOld(r, 3) = dNew(n, 3) Then staHarga = "Tetap"
If dOld(r, 3) > dNew(n, 3) Then staHarga = "Turun"
NewTbl(n, 5) = "Harga " & staHarga
Exit For
End If
'--Jika Status NewItemFound tidak terdeteksi
If r <= oRow And Not NewItemFound Then
'--pada field 5 dituliskan begini...
NewTbl(n, 5) = "Item Baru"
End If
Next r
Next n
' merapihkan kolom
NewTbl.CurrentRegion.Columns.AutoFit
Application.Calculation = xlCalculationManual
End Sub

Dear Misyanto,

 

File terlampir, yang dibuat oleh bu guru STDEV(i) mungkin bisa dipakai.

 

Regards

Herry Sutjipto

 

From: XL-mania@yahoogroups.com [mailto:XL-mania@yahoogroups.com] On Behalf Of misyanto
Sent: 26 April 2011 15:35
To: XL-mania@yahoogroups.com
Subject: ]] XL-mania [[ Cara cepat mencari part number baru ?

 

Maaf attachment ketinggalan

 

From: misyanto [mailto:misyanto_qa@wooin.co.id]
Sent: Tuesday, April 26, 2011 1:34 AM
To: 'XL-mania@yahoogroups.com'
Subject: Cara cepat mencari part number baru ?

 

Dear master master excel..

 

Sy awam dgn excel, mohon bantuan dari rekan semua.

Kasusnya spt ini,

-       Sy membuat list A yg berisi semua part number barang yg sudah di produksi

-       Sy juga setiap hari di kirimkan list B ( planning produksi update) oleh custumer yg berisi gabungan part number yg sudah di produksi maupun part number baru yg akan di produksi

Permasalahnya adalah bagaimana agar part number baru dapat otomatis di temukan dgn cepat / di tandai dgn warna font yg berbeda misalnya atau otomatis tertandai dgn keterangan “new” misalnya.

 

Contoh

Part no ADV74072401 blm ada di list A tetapi ada di list B

 

Terima kasih sy ucapkan atas kemurahan hati rekan semua

 

Misyanto Rachmat

QA Eng Div

Office ; ( 021 ) 89982683-111

Phone ; 081288884988

 

“bukan bahagia yang membuat and bersyukur, tetapi bersyukur yang membuat anda bahagia”