End SubSub TambahanZZ(MyArray, posisikey) seharusnya di pisah jadi : End Sub Sub TambahanZZ(MyArray, posisikey)
To: [email protected] From: [email protected] Date: Mon, 5 Dec 2011 17:01:39 +0800 Subject: Re: [belajar-excel] Masalah Lookup yang rumit Pak Sudarsono, Kode macro yang kedua ada Compile error message " Sub or function not define " Saya udah coba debug namun tidak berhasil. Mohon sekali lag bantuan bapak. Terima kasih -Mansor 2011/12/2 jkssxls Sudarsono <[email protected]> Option Base 1 Dim kdAccLedger As Long Dim kdAccCustomer As Long Dim urutTrans As Long Sub testing() 'tambahkan no urut transaksi urutTrans = 0 kdAccLedger = 871814 kdAccCustomer = 6932942 '==== Call telusuriData(Worksheets("Sheet1").Range("A32:J42"), Worksheets("Sheet2").Range("a13")) End Sub Function telusuriData(daerahku As Range, tujuannya As Range) m_NoReferensi = "" Dim kolstr_Tanggal, kolnum_Debet, kolNum_kredit, kolstr_NoReference As Integer kolstr_Tanggal = 1 kolstr_Deskripsi = 2 kolnum_Debet = 3 kolNum_kredit = 4 kolstr_NoReference = 7 kolStr_Remark = 10 Dim sel As Range Dim Arr_Simpan() As Variant Dim jumItem As Integer jumItem = 0 For Each sel In daerahku.Rows isiNoReferensi = sel.Resize(1, 1).Offset(0, kolstr_NoReference - 1).Value ' jika ada perubahan no reference If m_NoReferensi <> isiNoReferensi Then If m_NoReferensi <> "" Then ' jika no referensi sbelumnya tak kosong Call sortArray_2D(Arr_Simpan, 1) Call hilangkantambahan(Arr_Simpan, 1) Call TambahanZZ(Arr_Simpan, 1) Call SimpanKetujuan(Arr_Simpan, tujuannya) End If m_NoReferensi = sel.Resize(1, 1).Offset(0, kolstr_NoReference - 1).Value jumItem = 0 ReDim Arr_simpam(1, 1) End If If isiNoReferensi <> "" Then jumItem = jumItem + 1 ReDim Preserve Arr_Simpan(7, jumItem) '1--> posting key '2--> Amount '3--> MM atau ZZ '4--> Transaction Date '5--> No Reference '6--> Remark '7--> Acc No , dari mana If sel.Resize(1, 1).Offset(0, kolnum_Debet - 1).Value > 0 Then Arr_Simpan(2, jumItem) = sel.Resize(1, 1).Offset(0, kolnum_Debet - 1).Value Else Arr_Simpan(2, jumItem) = sel.Resize(1, 1).Offset(0, kolNum_kredit - 1).Value End If If UCase(Trim(sel.Resize(1, 1).Offset(0, kolstr_Deskripsi - 1).Value)) = "TOTAL" Then Arr_Simpan(3, jumItem) = "MM" ' untuk total sisi Bank debet ( 31 ) perusahaan Kredit ( 25 ) If sel.Resize(1, 1).Offset(0, kolnum_Debet - 1).Value > 0 Then Arr_Simpan(1, jumItem) = 25 & "_" & "0" Else Arr_Simpan(1, jumItem) = 31 & "_" & "0" End If isiTanggal = sel.Resize(1, 1).Offset(0, kolstr_Tanggal - 1).Value isiNoReference = sel.Resize(1, 1).Offset(0, kolstr_NoReference - 1).Value Else ' sisi Bank debet ( 25 ) perusahaan Kredit ( 31 ) Arr_Simpan(3, jumItem) = "" If sel.Resize(1, 1).Offset(0, kolnum_Debet - 1).Value > 0 Then Arr_Simpan(1, jumItem) = 31 & "_" & jumItem Else Arr_Simpan(1, jumItem) = 25 & "_" & jumItem End If isiTanggal = "" isiNoReference = "" End If ' tak perlukan lagi Arr_Simpan(4, jumItem) = isiTanggal Arr_Simpan(5, jumItem) = isiNoReference Arr_Simpan(6, jumItem) = sel.Resize(1, 1).Offset(0, kolStr_Remark - 1).Value ' Arr_Simpan(7, jumItem) = "" ' diisi dari mana ? Arr_Simpan(7, jumItem) = kdAccCustomer End If labloop: Next Call sortArray_2D(Arr_Simpan, 1) Call hilangkantambahan(Arr_Simpan, 1) Call TambahanZZ(Arr_Simpan, 1) Call SimpanKetujuan(Arr_Simpan, tujuannya) End Function Sub sortArray_2D(MyArray, posisikey) jumkol = UBound(MyArray, 1) Dim kel1 As Variant Dim kel2 As Variant ReDim kel1((jumkol)) ReDim kel2((jumkol)) For lLoop = 1 To UBound(MyArray, 2) For lLoop2 = lLoop To UBound(MyArray, 2) If UCase(MyArray(posisikey, lLoop2)) < UCase(MyArray(posisikey, lLoop)) Then For i = 1 To UBound(MyArray, 1) kel1(i) = MyArray(i, lLoop) kel2(i) = MyArray(i, lLoop2) MyArray(i, lLoop) = kel2(i) MyArray(i, lLoop2) = kel1(i) Next End If Next lLoop2 Next lLoop End Sub Sub hilangkantambahan(MyArray, posisikey) For j = 1 To UBound(MyArray, 2) strnya = MyArray(posisikey, j) strnya = StrReverse(strnya) posisi = InStr(1, strnya, "_") If posisi > 0 Then strnya = Mid(strnya, posisi + 1) End If strnya = StrReverse(strnya) MyArray(posisikey, j) = strnya Next j End SubSub TambahanZZ(MyArray, posisikey) '1--> posting key '2--> Amount '3--> MM atau ZZ '4--> Transaction Date '5--> No Reference '6--> Remark '7--> Acc No , dari mana ' MM ZZ ' 25 25 ' 50 ' 31 31 ' 40 jumItem = UBound(MyArray, 2) For j = 1 To jumItem If j = 1 And MyArray(3, j) = "MM" Then mPostingKey = MyArray(posisikey, j) mAmount = MyArray(2, j) mdoc = "ZZ" mTanggal = MyArray(4, j) mReferenceNo = MyArray(5, j) mRemark = MyArray(6, j) mAccNo = MyArray(7, j) End If Next j ReDim Preserve MyArray(7, jumItem + 1) MyArray(posisikey, jumItem + 1) = mPostingKey MyArray(2, jumItem + 1) = mAmount MyArray(3, jumItem + 1) = mdoc MyArray(4, jumItem + 1) = mTanggal MyArray(5, jumItem + 1) = mReferenceNo MyArray(6, jumItem + 1) = mRemark MyArray(7, jumItem + 1) = kdAccCustomer If mPostingKey = 25 Then mPostingKey = 50 ElseIf mPostingKey = 31 Then mPostingKey = 40 Else mPostingKey = "" End If jumItem = jumItem + 1 ReDim Preserve MyArray(7, jumItem + 1) MyArray(posisikey, jumItem + 1) = mPostingKey MyArray(2, jumItem + 1) = mAmount MyArray(3, jumItem + 1) = "" ' mdoc ' MyArray(4, jumItem + 1) = mTanggal MyArray(4, jumItem + 1) = "" ' MyArray(5, jumItem + 1) = mReferenceNo MyArray(5, jumItem + 1) = "" MyArray(6, jumItem + 1) = mRemark ' MyArray(7, jumItem + 1) = mAccNo MyArray(7, jumItem + 1) = kdAccLedger End Sub Sub SimpanKetujuan(MyArray, Tujuan As Range) Dim pjumItem As Integer '1--> posting key '2--> Amount '3--> Doc Type : MM atau ZZ '4--> Transaction Date '5--> No Reference '6--> Remark '7--> Acc No , dari mana '==== ' Tanggal Doc-Type ReferenceNo PostingKey AccNo Amount Remark pjumItem = UBound(MyArray, 2) For j = 1 To pjumItem 'tambahkan no urut transaksi If MyArray(3, j) <> "" Then urutTrans = urutTrans + 1 Tujuan.Offset(j - 1, 0).Value = urutTrans End If Tujuan.Offset(j - 1, 1).Value = MyArray(4, j) Tujuan.Offset(j - 1, 2).Value = MyArray(3, j) Tujuan.Offset(j - 1, 3).Value = MyArray(5, j) Tujuan.Offset(j - 1, 4).Value = MyArray(1, j) Tujuan.Offset(j - 1, 5).Value = MyArray(7, j) Tujuan.Offset(j - 1, 6).Value = MyArray(2, j) Tujuan.Offset(j - 1, 7).Value = MyArray(6, j) Next j Set Tujuan = Tujuan.Offset(pjumItem, 0) End Sub > To: [email protected] > From: [email protected] > Date: Fri, 2 Dec 2011 16:32:07 +0800 > Subject: Re: [belajar-excel] Masalah Lookup yang rumit > > Pak Sudarsono, > > Menurut saya hasilnya udah 95% memenuhi kebutuhan saya. > (1) Yang kurang hanya sedikit, di kolom yang kosong maunya diisi no account > yang tetap yaitu 6932942.mungkin boleh disebut di makro Acc No = 6932942. > Bagitu juga GL 871814 adalah tetap dan tidak berubah, dan polanya tetap > sama seperti posisi di table asli di bawah. > > (2) Di kolom pertama sebelum tanggal ada nomor urut. Polanya no 1 berada di > baris yang sama dgn MM, no 2 di baris ZZ, no 3 MM semula, bagitulah > seterusnya no 4 ZZ. > > (3) Tanggal hanya ditulis dua kali sahaja yaitu sebaris dgn MM dan sebaris > dgn ZZ, yang lain dikosongkan sama seperti MM dan ZZ. > > 4) Selain untuk tujuan upload data ke sistem SAP, Table ini juga > berfungsi sebagai filter kepada Table statement dari bank, sebab data dari > bank bertambah setiap hari, tapi yang mau di lihat hanya data dari tanggal > tertentu sahaja.. Mungkin supaya lebih user friendly, tanggalnya bisa > diselect contohnya > > Tanggal dari 18 Nov 2011 hingga 23 Nov 2011 atau hanya satu tanggal sahaja > e.g 24 Nov 2011, maka yang muncul hanyalah tanggal yang diperlukan sahaja. > > Terima kasih sekali lagi atas bantuan bapak. > > -Mansor.
