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 kolom
> Kemudian 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
>
>
> cmiiw
> w
>
>
> 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-
>
>
>
>
>
>
>
>
>
>
