Terimakasih banyak Mr. Kid, Saya sudah coba di file yang Mr. Kid lampirkan dan sangat smart
Nah... sekarang lagi berusaha menerapkan itu ke file saya yang sebenarnya :-) Bahasanya agak asing buat saya (taunya baru seputaran for he..he..) Bila tidak keberatan, sudi kiranya menyertakan keterangan-keterangan (remark) maksud dari bahasa tersebut (untuk bahasa yang sulit saja (tulisan merah bold :-) Bila Mr. Kid ada waktu saja. Sambil saya pelajari sendiri. Again..., terimakasih Salam, gusti ________________________________ From: belajar-excel@yahoogroups.com [mailto:belajar-ex...@yahoogroups.com] On Behalf Of Mr. Kid Sent: Wednesday, February 17, 2010 3:29 PM To: belajar-excel@yahoogroups.com Subject: Re: [belajar-excel] Macro Dear Gusti, Coba manfaatkan fitur autofilter. Public Sub update_unsur_dari_b() Dim wbkB As Workbook Dim wbkA As Workbook Dim rngDt As Range Dim lDate As Long On Error Resume Next Application.ScreenUpdating = False Set wbkA = ThisWorkbook Set wbkB = Workbooks("B.xls") If Err.Number <> 0 Then Err.Clear Set wbkB = Workbooks.Open(ThisWorkbook.Path & "\B.xls") End If lDate = wbkA.Sheets("Sheet1").Range("b1") 'supaya tidak terjebak error karena match, cek dulu dengan countif If WorksheetFunction.CountIf(wbkB.Sheets("Sheet1").Range("a:a"), lDate) > 0 Then 'ambil nilai unsur-unsur lDate = WorksheetFunction.Match(lDate, wbkB.Sheets("Sheet1").Range("a:a"), 0) 'filter target by date With wbkA.Worksheets("Sheet1") .AutoFilterMode = False Set rngDt = .Range("a3").CurrentRegion rngDt.Resize(columnsize:=1).NumberFormat = "GENERAL" rngDt.AutoFilter Field:=1, Criteria1:="=" & CLng(.Range("b1").Value) Set rngDt = rngDt.Offset(1, 1).Resize(rngDt.Rows.Count - 1, 1) rngDt.SpecialCells(xlCellTypeVisible).Value = wbkB.Sheets("Sheet1").Range("b" & lDate) rngDt.Offset(0, 1).SpecialCells(xlCellTypeVisible).Value = wbkB.Sheets("Sheet1").Range("c" & lDate) .AutoFilterMode = False rngDt.Offset(0, -1).Resize(columnsize:=1).NumberFormat = "d-mmm-yyyy" End With End If wbkB.Close False wbkA.Activate Application.ScreenUpdating = True End Sub Regards. Kid. 2010/2/17 Posi, Yugustin (PTI-SOR) <yugustin.p...@valeinco.com <mailto:yugustin.p...@valeinco.com> > Dear All, Mohon pencerahannya, Saya membuat macro, tujuannya untuk mengupdate kolom unsur1 dan unsur2 di Workbook A.xls yang mana datanya itu di ambil dari Workbook B.xls by kolom Date. Mohon dicek bahasa macronya di file Workbook A.xls. Macronya sudah berhasil tapi saat macro dijalankan, butuh banyak waktu untuk sampai ke hasil akhir karena macronya mengecek mulai dari baris pertama sampai baris terakhir di kedua Workbook tersebut. Padahal kedua workbook ini kenyataannya memiliki ribuan rows Untuk mengecek macronya, silakan copy 2 file terlampir ke computer anda kemudian buka file A dan File B, jalankan macronya dengan klik tombol update unsur di file A.xls Di file A.xls, user harus menuliskan tanggal berapa yang akan diupdate di cells "B1" Harapan saya, semoga ada solusi hingga macronya bisa disederhanakan dan bisa langsung mengupdate tanggal yang di maksudkan oleh user. Demikian, semoga pertanyaannya jelas Terimakasih, Salam, gusti <<B.xls>> <<A.xls>> Sub update_unsur() Wbook_A = "A.xls" Wbook_B = "B.xls" Workbooks(Wbook_A).Activate Sheets("Sheet1").Select My_A_Rows = Range("A3").CurrentRegion.Rows.Count Date_A = Cells(1, 2) For g = 2 To My_A_Rows Cells(g, 1).Select If Cells(g, 1) <> Date_A Then GoTo berikut_g If Cells(g, 1) = Date_A Then Workbooks(Wbook_B).Activate My_B_Rows = Range("a1").CurrentRegion.Rows.Count For y = 2 To My_B_Rows Cells(y, 1).Select Date_B = Cells(y, 1) If Date_B <> Date_A Then GoTo berikut_y If Date_B = Date_A Then Unsur1 = Cells(y, 2) Unsur2 = Cells(y, 3) Workbooks(Wbook_A).Activate Sheets("Sheet1").Select Cells(g, 2) = Unsur1 Cells(g, 3) = Unsur2 GoTo berikut_g End If berikut_y: Next y End If berikut_g: Next g End Sub
