saya koreksi ya Mr Kids :col.Add rng.Value & "|" & rng.Offset(, 1).Value & "|"
& rng.Offset(, 2).Value, rng.Value & "|" & rng.Offset(, 1).Value
menjadi :col.Add rng.Value & "|" & rng.Offset(, 1).Value & "|" & rng.Offset(,
2).Value, rng.Offset(, 1).Value
dimana key menggunakan kolom yang berisi A,B,C,D,E ( kolom ke-2 atau relatif
satu kolom kekanan )sehingga lengkapnya : Public Function
JoinPakeKoleksi(rngUpdateKolomPertama As Range, rngDataLamaKolomPertama As
Range) As Variant
Dim col As Collection 'selalu base 1
Dim rng As Range
Dim lRecs As Long
Dim sItem() As String 'vb6 menggunakan default base 0
Dim vRes As Variant
On Error Resume Next
Set col = New Collection
'mulai dari updater
For Each rng In rngUpdateKolomPertama
If LenB(rng.Value) <> 0 Then
col.Add Item:=rng.Value & "|" & rng.Offset(, 1).Value & "|" &
rng.Offset(, 2).Value, _
Key:=rng.Offset(, 1).Value
End If
Next rng
'ikuti dengan data lama
For Each rng In rngDataLamaKolomPertama
If LenB(rng.Value) <> 0 Then
col.Add Item:=rng.Value & "|" & rng.Offset(, 1).Value & "|" &
rng.Offset(, 2).Value, _
Key:=rng.Offset(, 1).Value
End If
Next rng
lRecs = col.Count
ReDim vRes(1 To lRecs, 1 To 3) As Variant
For lRecs = 1 To col.Count
MsgBox col(lRecs)
sItem = Split(col(lRecs), "|")
vRes(lRecs, 1) = sItem(0)
vRes(lRecs, 2) = sItem(1)
vRes(lRecs, 3) = sItem(2)
Next lRecs
JoinPakeKoleksi = vRes
End Function
To: belajar-excel@yahoogroups.com
From: mr.nm...@gmail.com
Date: Thu, 29 Sep 2011 14:44:37 +0700
Subject: Re: [belajar-excel] Update Tabel dari sheet lain...
Coba juga menggunakan object collection untuk join table
Public Function JoinPakeKoleksi(rngUpdateKolomPertama As Range,
rngDataLamaKolomPertama As Range) As Variant
Dim col As Collection 'selalu base 1
Dim rng As Range
Dim lRecs As Long
Dim sItem() As String 'vb6 menggunakan default base 0
Dim vRes As Variant
On Error Resume Next
Set col = New Collection
'mulai dari updater
For Each rng In rngUpdateKolomPertama
If LenB(rng.Value) <> 0 Then
col.Add rng.Value & "|" & rng.Offset(, 1).Value & "|" &
rng.Offset(, 2).Value, _
rng.Value & "|" & rng.Offset(, 1).Value
End If
Next rng
'ikuti dengan data lama
For Each rng In rngDataLamaKolomPertama
If LenB(rng.Value) <> 0 Then
col.Add rng.Value & "|" & rng.Offset(, 1).Value & "|" &
rng.Offset(, 2).Value, _
rng.Value & "|" & rng.Offset(, 1).Value
End If
Next rng
lRecs = col.Count
ReDim vRes(1 To lRecs, 1 To 3) As Variant
For lRecs = 1 To col.Count
sItem = Split(col(lRecs), "|")
vRes(lRecs, 1) = sItem(0)
vRes(lRecs, 2) = sItem(1)
vRes(lRecs, 3) = sItem(2)
Next lRecs
JoinPakeKoleksi = vRes
End Function
'Mungkin perlu dicoba untuk record update yang banyak dan record data yang juga
banyak.
Ingin di-sort ?
buat fungsi sorting yang inputnya berupa array, agar hasil fungsi di atas bisa
menjadi input parameter untuk fungsi sorting tersebut.
Regards.
Kid.
2011/9/29 jkssxls Sudarsono <jkss...@hotmail.com>
saya modif fungsi join menjadi join_m
Private Function JOIN_m(L01 As Range, L02 As Range)
'=== siti Vi : Fungsi JOIN : menggabung dua List
' modified by Haps: 29 sep 2011
' tiap list berisi 3 kolom, Uniq pada Kolom 1 (ID)
'=================================================
Dim ArS As String, ArUp(), Tmp
Dim i As Long, j As Long, p As Long, u As Long
Dim kolomkey As Integer
kolomkey = 2
' menyusun 3 array ex tabel data
ArS = "|"
ReDim Preserve ArUp(1 To 3, 1 To L01.Rows.Count)
For i = 1 To L01.Rows.Count
'isi string dari kolom H1 ( berisi A,B,C,D )
ArS = ArS & L01(i, kolomkey) & "|"
ArUp(1, i) = L01(i, 1)
ArUp(2, i) = L01(i, 2)
ArUp(3, i) = L01(i, 3)
Next i
' array tabel diperbesar dengan data di L02 (update)
' j = UBound(ArUp)
' ambil banyaknya data di dimensi ke-2 : A B C D
j = UBound(ArUp, 2)
For i = 1 To L02.Rows.Count
' jika ID di L02 belum ada di L01.. maka..
If InStr(1, ArS, "|" & L02(i, kolomkey) & "|") = 0 Then
' jika data di L02 tak ada di ArS
ArS = ArS & L02(i, kolomkey) & "|"
j = j + 1: ReDim Preserve ArUp(1 To 3, 1 To j)
ArUp(1, j) = L02(i, 1)
ArUp(2, j) = L02(i, 2)
ArUp(3, j) = L02(i, 3)
Else ' jika ID di list L02 sudah ada di L01 (kembar)
' Nilainya H2-nya diambilkan dari L02 (data pengUpdate)
For p = 1 To j
If L02(i, kolomkey) = ArUp(kolomkey, p) Then
' ganti data pada ArUp dgn data di L02 hanya index ke-3
ArUp(3, p) = L02(i, 3)
Exit For
End If
Next p
End If
Next i
' bubble sort, mengurutkan hasil Array (sort by ID)
For i = LBound(ArUp) To UBound(ArUp) - 1
For u = LBound(ArUp) To UBound(ArUp) - 1
If ArUp(kolomkey, u) > ArUp(kolomkey, u + 1) Then
Tmp = ArUp(1, u): ArUp(1, u) = ArUp(1, u + 1): ArUp(1, u + 1) = Tmp
Tmp = ArUp(2, u): ArUp(2, u) = ArUp(2, u + 1): ArUp(2, u + 1) = Tmp
Tmp = ArUp(3, u): ArUp(3, u) = ArUp(3, u + 1): ArUp(3, u + 1) = Tmp
End If
Next u
Next i
' variable Join di-isi array ArUp (2 dimensi (3 kol * n row)
JOIN_m = ArUp
End Function
To: belajar-excel@yahoogroups.com
From: jkss...@hotmail.com
Date: Thu, 29 Sep 2011 05:13:38 +0000
Subject: RE: [belajar-excel] Update Tabel dari sheet lain...
data utama
ID
H1
H2
1
A
100
2
B
125
3
C
10
4
D
5
data updater
ID
H1
H2
1
C
200
2
B
0
5
E
15
data hasil update :
ID
H1
H2
1
A
200
2
B
0
3
C
10
4
D
5
5
E
15
seharusnya :
ID
H1
H2
1
A
100
2
B
0
3
C
200
4
D
5
5
E
15
hal ini karena yg menjadi pembanding adalah index ke -1 ( kolom Id ) ,
sebaiknya index -2 ( kolom H1 ).
Maaf sedikit mengoreksi .. tak apa -apa , kan....
To: belajar-excel@yahoogroups.com
From: jkss...@hotmail.com
Date: Thu, 29 Sep 2011 04:42:28 +0000
Subject: RE: [belajar-excel] Update Tabel dari sheet lain...
Mbak Haps , saya sudah coba , ada sedikit yang saya koreksi pada fungsi join :
j = UBound(ArUp) akan selalu menghasilkan 3
di koreksi menjadi
j = UBound(ArUp, 2) akan menghasilkan banyaknya data di range "data" (
worksheet "data" )
Tetapi saya berterima kasih atas fungsi Updatable dan join hasil modif nya
To: belajar-excel@yahoogroups.com
From: hapsari.stlizb...@gmail.com
Date: Thu, 29 Sep 2011 04:30:15 +0700
Subject: Re: [belajar-excel] Update Tabel dari sheet lain...
Fungsi JOIN telah dimodifikasi (lihat module), agar dapat menampung tabel
2 dimensi) 3 kolomKemudian Fungsi tsb dimanfaatkan untuk mengUpdate tabel data
dengan prosedur Sub.
Sudah dicoba sepertinya berhasil, hanya saja listing vba-code nya jadi
kepanjangan...
Sub UpdateTable()
' Haps // 28 sept 2011 '---------------------
Dim DatRng As Range, NewRng As Range, ArNew, r As Long
' init: Tabel Data (tanpa headernya)
Set DatRng = Sheets("Data").Cells(1).CurrentRegion.Offset(1, 0) Set DatRng
= DatRng.Resize(DatRng.Rows.Count - 1, DatRng.Columns.Count)
' init: Tabel pengUpdate (tanpa header)
Set NewRng = Sheets("Update").Cells(1).CurrentRegion.Offset(1, 0) Set
NewRng = NewRng.Resize(NewRng.Rows.Count - 1, NewRng.Columns.Count)
' -- membuat Array (3 kolom * n Baris) dibantu fungsi JOIN
ArNew = JOIN(DatRng, NewRng)
' -- hapus isi tabel data
DatRng.ClearContents
' -- tabel data (yg baru dikosongkan) diupdate dgn data dari Array
For r = 1 To UBound(ArNew, 2) DatRng(r, 1) = ArNew(1, r)
DatRng(r, 2) = ArNew(2, r) DatRng(r, 3) = ArNew(3, r)
Next r
DatRng.Parent.Activate MsgBox "Selesai", vbInformation, ThisWorkbook.Name
End Sub
cmiiww
2011/9/28 Haps <hapsari.stlizb...@gmail.com>
dulu, sudah lupa bulan / tahunnya, mba siti pernah membuat UDF Join
dua list jika di JOIN, berarti dua lis akan digabung, tetapi data kembar hanya
dimunculkan 1 kali
jika perlu hasil JOIN bisa diurutkan (sorted)
sementara belum sempat membuat /memodifikasi makro menjadi khusus untuk
keperluan
"sambil JOIN (kolom 1) juga sambil SUMIF (kolom 2)"
saya yakin mas zainul ulum bisa memodifikasi makro tsb agar dapat mengerjakan
keperluan
yg diajukan tsb, mungkin berupa prosedur Sub bukan FUnction lebih cuocokk....
ini sudah seijin mbak siti contoh UDF JOINT dilampirkan di sini
'---text / VBA codeing UDF Join
Function JOIN(List1 As Range, List2 As Range, Optional N As Long = 0, _
Optional Urutkan As Boolean = False)
'----- End Function
2011/9/28 zainul ulum <<yahoo>> <zainul_u...@yahoo.com>
Be-exceler,
Misalnya saya mempunyai table di [sheet 1] dan [Sheet 2].
Table di [sheet 1] akan diupdate berdasarkan record dari [Sheet 2].
Bagaimanakah codenya (macro) agar record di [sheet 1] bisa terupdate
berdasarkan perubahan di [Sheet 2]?
Terimakasih,
-zainul-
