berikut makro yg loopnya tidak bertingkat
karena pencarian kesamaan data digunakan countif dan match
dua fungsi ya dipinjam dari worksheet.
dari kemarin mau diposted tapi terganggu koneksi yg jelex...
mohon pak herry coba barangkali saja ada perbaikan di penggunaan waktu...
meskipun begitu
siti tidak ingin orang berpendapat bahwa dengan countif atau match lalu
perulangan sebenarnya telah berhasil diHINDARI
secara coding, memang dihindari tetapi sebenarnya apa yg terjadi di dalam
fungsi
MATCH maupun COUNTIF juga berisi looping. hanya saja karena oleh microsoft
programnya tidak ditulis dengan VBA (he he he) tetapi dengan bhs yg lebih
dekat ke mesin; lagipula oleh para ahlinya,
maka kecepatannya tidak akan tertandingi oleh looping buatan sendiri pakai
bhs tingkat tinggi spt VB/VBA
CMIIW..
jika makro-makro-an ini ternyata masih "4 jam belum selesai" saya kira ..
it is time to melirik ke *penggunaan sql yg pernah ditawarkan mas kid..* he
he..
halo mas kid....
'------------------
Sub ctv_UpdateHarga()
'---------------------------------------------------
' siti Vi : mengupdate tabel dengan tabel lain
' <> modifikasi III / kampung bluewek, 23 apr 2009
' meminjam fungsi Countif dan Match dari woksit
'---------------------------------------------------
' workbook "Perubahan Harga" harus sudah dibuka
'---------------------------------------------------
Dim OldList As Range
Dim NewList As Range
Dim olRow As Long
Dim neRow As Long
Dim StHga As String
Dim OldItemFound As Boolean
Dim r As Long, n As Long, i As Long
' kenali wilayah PerubahanHarga, diingat sbg range_"NewList"
' terutama kolom kunci-nya (kolom I)
Set NewList = Workbooks("Perubahan Harga.xls"). _
Sheets("Perubahan_Harga").Range("A1").CurrentRegion.Offset(1, 0)
neRow = NewList.Rows.Count - 1
Set NewList = NewList.Resize(neRow, 1)
ThisWorkbook.Activate
' begitujuga dgn wilayah DaftarHarga, sbg Range_"OldList"
Set OldList = Sheets("Daftar_Harga").Range("A1").CurrentRegion.Offset(1,
0)
olRow = OldList.Rows.Count - 1
Set OldList = OldList.Resize(olRow, 1)
Application.Calculation = xlCalculationManual
'--data kolom HargaBaru dipindah ke kolom HargaLama
OldList(1, 3).Resize(olRow, 1).Copy
OldList(1, 4).PasteSpecial xlPasteValues
OldList(1, 3).Resize(olRow, 1).ClearContents
' === Tahap Pertama ===
' catat item lama (termasuk item yg "ndak ada" di Tbl Perubahan_Harga
' loop kunjungan ke setiyap record di *wilayah OldList*
For r = 1 To olRow
OldItemFound = False
' APABILA KodeItem pada records yg sedang dikunjungi
' ternyata ADA di New List (>>Countif kan ya..?)
' penggunaan countif untuk mentest adanya data = kriteria, tidak
' dapat sekaligus dipecayakan dalam MATCH, karena di VBA, MATCH
' yang 'gagal' bukan menghasilkan 0 spt COUNTIF melainkan
' menerbitkan ELLOL-Message yg malu-maluin...
' (mungkin ada cara lain yg tidak perlu DUA kali proses spt
ini)
If WorksheetFunction.CountIf(NewList, OldList(r, 1)) > 0 Then
' keadaan ini diberi flag
OldItemFound = True
' truzz cari *LETAK/POSISI/RowIndex nya* (>>Match), simpan di var *
n*
n = WorksheetFunction.Match(OldList(r, 1), NewList, 0)
' Harga pada NewList (baris ke n) diCompare vs
' Harga pada OldList (baris ke r), truzz ditentukan sEtatusnya
Select Case OldList(r, 4).Value
Case Is < NewList(n, 3): StHga = "Naik"
Case Is = NewList(n, 3): StHga = "Tetap"
Case Is > NewList(n, 3): StHga = "Turun"
End Select
' truss ditulis di 3 cell sebaris, di tabel OldList
OldList(r, 3) = NewList(n, 3)
OldList(r, 5) = StHga
OldList(r, 6) = Date
End If
' JiKalau Saringan IF di atas tidak bekerja (yg berarti
' OldItemFound tetap berFlag = FALSE
If OldItemFound = False Then
' mencatatnya "Gini" ajah...
OldList(r, 3) = OldList(r, 4)
OldList(r, 5) = "Tidak Ada Data"
End If
Next r
'=== Tahap Kedua ===
' RowIndex penulisan (di OldList) selanjutnya adalah baris yg
' posisinya berada SETELAH Angka JumlahBaris pada OldList
i = olRow
'--mencatat NewItems...
' Loop Kunjungan ke setiap records di *tabel NewList.*.
For n = 1 To neRow
' manakala KodeItem di NewList tiada penampakannya di OldList..
If WorksheetFunction.CountIf(OldList, NewList(n, 1)) = 0 Then
i = i + 1
OldList(i, 1) = NewList(n, 1)
OldList(i, 2) = NewList(n, 2)
OldList(i, 4) = NewList(n, 3)
' mauk bilang apa lagi kita (kalo bukan ) .....
OldList(i, 5) = "Baru"
OldList(i, 6) = Date
End If
Next n
' Wilayah OldRange 'kan udah di-obok-obok orang, maka
' perlu dikenali lagi batas/dimensinya
Set OldList = OldList.CurrentRegion
' diurutkan by KodeItem
Call Sort_ResultTbl(OldList)
'dirapihkan kolom-width-nya
OldList.Columns.AutoFit
Application.Calculation = xlCalculationManual
End Sub
Private Sub Sort_ResultTbl(RangeHasil As Range)
' Sorting menggunakan metoda dari menu Data Sort
RangeHasil.Sort _
Key1:=Range("A2"), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
RangeHasil(1, 1).Select
End Sub
'-------------------------------------
2009/4/24 siti Vi <[email protected]>
> seperti yg siti khawatirkan, makro kemarin itu menyelenggarakan loop
> bertingkat-dua sebanyak duakali
> kalau jumlah records 100, akan terjadi pembacaan max 100 * 100 + 100 * 99
> kali.
> angka tepatnya lebih kecil dari itu karena
> mungkin ada trick lain untuk mempercepatnya..
> begitulah kalau makro dibuat dengan contoh data yg terlalu jauh dari
> factuadatanya
> si "penulis" tidak sempat mencoba di lapangan yg sesungguhnya...
>
> sebagian perulangan sebetulnya hanya mencari kesamaan data; dan oleh karena
> itu dapat digantikan
> dengan fungsi MACTH milik worksheet
> meminjam fungsi worksheet, di vba bisa dilaksanakan dengan object
> WorksheetFunction
> dan kebetulan MTACH dalah fungsi yg dapat dipakai di VBA. dengan bbentuk
> spt ini
> n =* WorksheetFunction.Match(arg1,arg2,arg3)*
>
> mungkin pula ada bagian yg perlu dihilangkan demi memperkecil jumlah
> instruksi dan pemakaian memori
>
> sementara itu yg dapat siti katakan,
> jika contoh data yg "agak besar" & "agak mendekati faktualnya" boleh
> dikirim
> mungkin bisa dicari-cari trick lain yg tidak terlalu "4 jam"
>
> dan barangkali topik ini sudah tidak bersifat umum lagi, mail berikutnya
> boleh via japri saja...
> ('gitu kan ya bang mods...)
>
> ctv
>
>
>
> 2009/4/22 Herry Sutjipto <[email protected]>
>
>>
>> Dear mbak siti Vi,
>> Maaf mbak siti, pertanyaan saya no 2, hanya ingin tahu apakah macronya
>> jalan dengan sempurnya (sekali lagi minta maaf bukannya ngetes mbak siti lho
>> …..).
>> Contoh dari mak siti sudah saya coba dengan data betulan.
>> Jumlah file “Daftar Harga” 22.714 baris (row), sedangkan jumlah file
>> “Perubahan Harga” 15.479 baris (row). Sepertinya Laptop saya nggak mampu
>> mengerjakannya, saya tinggal tidur kira-kira 4 jam belum selesai (jumlah
>> iterasinya = 2 x 22.714 x 15.479 = 703.180.012 ?? Wouuw ….. besar sekali ya
>> …..?)
>>
>> Kalau saya coba masing-masing dengan 500 baris masih bisa diselesaikan
>> oleh Laptop saya (Pentium 4 dengan RAM 256 MB + 512 MB). Kira-kira apa jalan
>> keluarnya ya? Apakah bisa menggabungkan formula XL didalam macro tersebut?
>> Saya sudah baca-baca namun belum ngerti juga untuk menggunakan Xl formula
>> dalam macro. Bagaimana trik belajar Xl formula dalam macro yang mudah?
>> Tolong dong bagi-bagi pengalaman, supaya saya ndak nanyak melulu (mboseni
>> ya???). Sepertinya macro untuk XL banyak sekali trik-triknya ya …..? Ndak
>> seperti FORTRAN yang melulu menggunakan logika dan rumus2 matematis (saya
>> dulu waktu masih sekolah belajar FORTRAN dan BASICA). Apa karena sudah tua
>> ya …. Begitu mau belajar VB untuk XL kok susahnya setengah mati.
>>
>> Terima kasih atas penjelasannya.
>>
>> Best regards
>> herrysri
>>
>
