Re: ]] XL-mania [[ Re: Otomatis insert data antar sheet di excell

 

VBA Coding temuan pak Indra memerlukan  sekitar 168 baris statement &/ expresi

banyaknya perintah (dan Prosedur) itu antara lain karena untuk setiap SHEET TUJUAN

dibuatkan PROCDURE (Makro) tersendiri, nama sheet di tentukan secara HardCoded;

posting dengan cara pengambilan value cell per cell..

Sekarang ini Walaupun sudah terlambat (dan menurut pak Indra problem sudah diatasi) 

kita ajukan coding dengan gaya lain (45 baris perintah) , gaya aliran bluewater.. (bercanda....)

Jika Sheet Tujuan bertambah, tidak perlu mengedit makro.

1.

Kita perlukan 1 kolom tambahan (Kolom R), cell di kolom ini jika di tuliskan sesuatu apa saja

akan menjalankan sebuah  Prosedur Event

2.

Pada Module Sheet ("Data") kita buat Prosedur Event "Worksheet_Change"

Dengan cara itu diharapkan Prosedur ini akan bereaksi (menjalankan inti makronya) jika 

Kolom R (mulai row 2) dituliskan suatu data (kecuali "NO")

Pada IntiMakro nya terdapat sebuah perintah memanggil/menjalankan prosedur lain

sambil mengirimkan 2 Argument: Nama Sheet Tujuan (ex data kolom A) dan  Range Sebaris 

yg akan diposted.

3

Pada Module Umum/Standard (dibuat dengan VBE Menu Insert > Module)

barulah kita buat perintah melaksanakan posting.

Agar supaya posting di Sheet Tujuan tidak menimpa atau pun loncat dari data/tabel  yg sudah ada;

maka IndexBaris musti kudu dihitung juga dlm prosedur ini; yaitu dengan melihat tinggi 

tabel yg sudah ada  +1

Di Module Umum: Rara juga Tambahkan UDF (Fungsi) men-Test apakah Nama Sheet tujuan

(ex kolom 1 / sheet "data) memang sudah ada SHEET-NYA

Misal Di Sheet "Data" Cell A9 tertulis "LAIN-LAIN/UMUM"

Sedangkan dlm workbook yg ada hanya Sheet bernama "UMUM"; Maka proses posting 

dengan berrat hati = ditolak mentah-mentah, (walapun sebenarnya bisa dibuat trick nya)

(kejam benar makro ini, ya karena dlm bermain2 dengan tabel dan data hendaknya kita 

menjauhi "Ambigu / Mendua"

Coding di Module Sheet"DATA" (25 baris)

Private Sub Worksheet_Change(ByVal Target As Range)

' - VBA Code: Rara Wilis; 15 Juni 2002

' - Case: http://tech.groups.yahoo.com/group/XL-mania/message/20615

' - purpose: mengEvaluasi apakah Posting perlu dilakukan..

'-------------------------------------------------------------------

   Dim BarisDipost As Range, NamaSht_7an As String

   If Target.Cells.Count = 1 Then

      If Target.Column = 18 Then

         If Target.Row >= 2 Then

            If Target.Value <> vbNullString Then

               If Target.Value <> "NO" Then

                  Set BarisDipost = Me.Cells(Target.Row, 1).Resize(1, 17)

                  NamaSht_7an = BarisDipost(1, 1).Value

                  If SheetFound(NamaSht_7an) Then

                     Call RecordsPosting(NamaSht_7an, BarisDipost)

                  Else

                     MsgBox "Sheet Tujuan (" & NamaSht_7an & ") belum ada , Oom..", vbCritical, "Posting Records"

                     Exit Sub

                  End If

               End If

            End If

         End If

      End If

   End If

End Sub

Coding di Module STANDARD (21 baris)

Sub RecordsPosting(ShtNm As String, RecLine As Range)

' - VBA Code: Rara Wilis; 15 Juni 2002

' - Case: http://tech.groups.yahoo.com/group/XL-mania/message/20615

' - Posting

'-------------------------------------------------------------------

   Dim Tabel7an As Range, IdxBaris7an As Long

   Set Tabel7an = Sheets(ShtNm).Cells(1).CurrentRegion

   IdxBaris7an = Tabel7an.Rows.Count + 1

   RecLine.Copy

   Tabel7an(IdxBaris7an, 1).PasteSpecial xlPasteValuesAndNumberFormats

   Application.CutCopyMode = False

End Sub

Function SheetFound(WsName As String) As Boolean

   ' pinjaman dari mbak siti Vi / Bluewater, 4 Jun 2011

   ' apakah suatu sheet ada di workbook - Tanpa loop

   Dim Ws As Worksheet

   On Error Resume Next

   Set Ws = Sheets(WsName)

   If Not Ws Is Nothing Then SheetFound = True

End Function

Semoga masih ada manfaatnya...

 

~Rara

2012/6/16 indra kurniawan <ikurniawan007@gmail.com>
> Dear Mas Arif,
>
> Terima kasih banyak atas bantuannya, setelah googling dan di temani secangkir kopi akhirnya ketemu juga dengan bantuan vba, Berikut hasilnya mungkin yang lain ada yang membutuhkan :)
> Rgd
> Indra
>
> Pada 15 Juni 2012 21:23, Darwis Arief <d_arief72@yahoo.com> menulis:
>>
>> Dear Indra,
>> Sebenarnya sdh bbrpkali dibahas dimilis ini. Terus terang saya juga blm master di Excel, tp sdh lama bergabung di milis
>> ini dan sdh banyak contoh2 Excel yg saya file. Saya mencoba buka file lama, dan kira2 gini jawannya:
>> Tulis rumus di cell A2 Sheet "PENGADAAN" dan ditutup dgn Array formula (dlm keadaan editing tekan tombol Ctrl + Shift + Enter).
>>
>> =IFERROR(INDEX(Data!B$2:B$11;SMALL(IF(Data!$A$2:$A$11="PENGADAAN";ROW(Data!$B$2:$B$11)-ROW(Data!$B$2)+1);ROW(1:1)));"")
>>
>> Semoga bisa membantu.....(trust me it works)
>> Salam,
>> d_arief

__._,_.___

Reply to sender | Reply to group | Reply via web post | Start a New Topic

Messages in this topic (4)

Recent Activity:

• New Members 43

Visit Your Group

+-:: XL-mania ::::::::::::::::::::----------------------------------+
| Woooowwww... member XL-mania tembus 20,000!!!                     |
+-------------------------------------------------------------------+
| DILARANG : MLM, money game, OOT, iklan tanpa izin, SARA, testing, |
| pembicaraan pribadi, one line message,  melecehkan,  tidak sopan. |
+-------------------------------------------------------------------+
| Buat subjek yang kreatif, jangan : "tanya", "help", "mohon bantu" |
| Usahakan besar attachment < 200 kb. Gunakan  winzip  jika  perlu. |
+-------------------------------------------------------------------+
| Ajak teman-teman Anda bergabung dengan mengirim e-mail kosong ke  |
| XL-mania-subscribe@yahoogroups.com atau kirimkan mereka file dari |
| http://groups.yahoo.com/group/XL-mania/files/Promotion/           |
+-------------------------------------------------------------------+
| Berikan testimoni di :                                            |
| http://www.xl-mania.com/2008/06/testimoni-xl-mania.html           |
+-------------------------------------------------------------------+
| Message lama ada di :                                             |
| http://groups.yahoo.com/group/XL-mania/messages [perlu yahoo id]  |
| http://www.mail-archive.com/xl-mania@yahoogroups.com              |
+-------------------------------------------------------------------+

Switch to: Text-Only, Daily Digest • Unsubscribe • Terms of Use

.

__,_._,___