maksudnya : jadi 2 sub rutin :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 Sub dan
Sub 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
To: [email protected]
From: [email protected]
Date: Mon, 5 Dec 2011 09:45:36 +0000
Subject: RE: [belajar-excel] Masalah Lookup yang rumit
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
MARKETPLACE
Stay on top of your group activity without leaving the
page you're on - Get the Yahoo! Toolbar now.
Switch to: Text-Only, Daily Digest • Unsubscribe • Terms of Use
.
