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.
