Hot Fox: Re: ]] XL-mania [[ Sekali lagi : mensederhanakan fungsi

segunda-feira, 14 de setembro de 2009

Re: ]] XL-mania [[ Sekali lagi : mensederhanakan fungsi

Dear Yusvi Adi M.,

Prosesnya adalah Copy lalu Paste (mungkin ke sheet lain, atau ke kolom lain sesheet)
Data yang di copy ada 2 bagian :
- Data profile di I8:I10 dan AC8 (di paste ke seluruh data pada kolom 2 cell aktif)
- Data transaksi di kolom AA, AE, AO, AT, BA, BJ:BK (dipaste ke kolom 6 cell aktif)

Data tambahan pada target :
- cell aktif berisi No. Urut data
- kolom 14 cell aktif adalah selisih tanggal dengan kolom 2 cell aktif

??? Kolom 13 cell aktif mungkin di kosongkan.

Kira-kira kode-nya sebagai berikut.
Letakkan pada sebuah prosedur. Baris kode berikut tidak perlu loop terhadap variable urut yang dulu dipakai.

     'jika sheet data sumber beda dengan sheet target, tambahkan syntax ekspresi object sheet didepan range
     'Worksheets("Nama_Sheet_Sumber").Range(bla-bla-bla.....
     'contoh : dari Range("i10").copy
     ' jadi Worksheets("Data Sumber").Range("i10").copy

     with acrivecell
       'data profile (urutan header target beda dengan source)
         'data di paste ke 6 baris, karena jumlah data transaksi yang di copy ada 6 baris
          Range("i10").copy
          .cells(1.2).resize(6).pastespecial xlPasteValues         'paste values ke 6 baris

          Range("i8").copy
          .cells(1.3).resize(6).pastespecial xlPasteValues         'paste values ke 6 baris

          Range("i9").copy
          .cells(1.4).resize(6).pastespecial xlPasteValues         'paste values ke 6 baris

Range("ac8").copy
.cells(1.5).resize(6).pastespecial xlPasteValues 'paste values ke 6 baris

          'data transaksi (urutan header sama =
          'setelah kolom kode pasti ketemu kolom barang dulu sebelum kolom jml
          'data yang di-copy adalah 6 baris (kasus ini dari baris 11 sampai baris 16)
          'ubah baris kode untuk membuatnya lebih dinamis
          Range("AA11:AA16, AE11:AE16, AO11:AO16, AT11:AT16, BA11:BA16, BJ11:BK16").copy
          .cells(1.6).PasteSpecial xlPastevalues

          'data no urut di aktif cell, untuk 6 baris
          'caranya dipasangi formula pembuat no.urut saja ya..
          .resize(6)="=N( R[-1]C ) +1"

          'data selisih tanggal
          .Cells(1, 14).resize(6) = "=TODAY()-RC[-12]"
     end with

Semoga bermanfaat.
Kid.

2009/9/14 Yusvi Adi M. <ivan_mustov@yahoo.com>

dear suhu-suhu excel yang terhormat
saat ini saya menggunakan VBA dalam excel seperti :

Set nama_unit = Range("I8")
   Set nama_manager = Range("I9")

   Set tglpesan = Range("I10")
   Set nama_member = Range("AC8")

   Set kode1 = Range("AA11")
   Set barang1 = Range("AE11")

   Set jml1 = Range("AO11")
   Set harga1 = Range("AT11")
   Set total1 = Range("BA11")
   Set disc1 = Range("BJ11")
   Set totals1 = Range("BK11")


   Set kode2 = Range("AA12")
   Set barang2 = Range("AE12")
   Set jml2 = Range("AO12")
   Set harga2 = Range("AT12")
   Set total2 = Range("BA12")

   Set disc2 = Range("BJ12")
   Set totals2 = Range("BK12")

   Set kode3 = Range("AA13")
   Set barang3 = Range("AE13")
   Set jml3 = Range("AO13")
   Set harga3 = Range("AT13")
   Set total3 = Range("BA13")
   Set disc3 = Range("BJ13")
   Set totals3 = Range("BK13")


   Set kode4 = Range("AA14")
   Set barang4 = Range("AE14")
   Set jml4 = Range("AO14")
   Set harga4 = Range("AT14")
   Set total4 = Range("BA14")
   Set disc4 = Range("BJ14")
   Set totals4 = Range("BK14")

   Set kode5 = Range("AA15")
   Set barang5 = Range("AE15")
   Set jml5 = Range("AO15")
   Set harga5 = Range("AT15")
   Set total5 = Range("BA15")
   Set disc5 = Range("BJ15")
   Set totals5 = Range("BK15")

   Set kode6 = Range("AA16")
   Set barang6 = Range("AE16")

   Set jml6 = Range("AO16")
   Set harga6 = Range("AT16")
   Set total6 = Range("BA16")
   Set disc6 = Range("BJ16")
   Set totals6 = Range("BK16")

kemudian disalin dengan fungsi
ActiveCell.Cells(1, 1) = urut + 1

   ActiveCell.Cells(1, 2) = tglpesan
   ActiveCell.Cells(1, 3) = nama_unit
   ActiveCell.Cells(1, 4) = nama_manager
   ActiveCell.Cells(1, 5) = nama_member
   ActiveCell.Cells(1, 6) = kode1
   ActiveCell.Cells(1, 7) = barang1
   ActiveCell.Cells(1, 8) = jml1
   ActiveCell.Cells(1, 9) = harga1
   ActiveCell.Cells(1, 10) = total1

   ActiveCell.Cells(1, 11) = disc1
   ActiveCell.Cells(1, 12) = totals1
   ActiveCell.Cells(1, 14) = "=TODAY()-RC[-12]"

     ActiveCell.Cells(2, 1) = urut + 2

   ActiveCell.Cells(2, 2) = tglpesan
   ActiveCell.Cells(2, 3) = nama_unit
   ActiveCell.Cells(2, 4) = nama_manager
   ActiveCell.Cells(2, 5) = nama_member
   ActiveCell.Cells(2, 6) = kode2
   ActiveCell.Cells(2, 7) = barang2
   ActiveCell.Cells(2, 8) = jml2
   ActiveCell.Cells(2, 9) = harga2
   ActiveCell.Cells(2, 10) = total2
   ActiveCell.Cells(2, 11) = disc2
   ActiveCell.Cells(2, 12) = totals2
   ActiveCell.Cells(2, 14) = "=TODAY()-RC[-12]"

   dst..

bagaimana ya untuk menyederhanakan rumus tersebut ?? terima kasih atas pencerahannya.

__._,_.___

Messages in this topic (2) Reply (via web post) | Start a new topic

Messages

+-:: XL-mania ::::::::::::::::::::----------------------------------+
| Ada lowongan jadi direktur ga? Hubungi momods please... :D        |
| http://www.facebook.com/group.php?gid=37671048001&ref=mf          |
+-------------------------------------------------------------------+
| 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.friendster.com/xlmania atau... |
| 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              |
+-------------------------------------------------------------------+

Change settings via the Web (Yahoo! ID required)
Change settings via email: Switch delivery to Daily Digest | Switch format to Traditional
Visit Your Group | Yahoo! Groups Terms of Use | Unsubscribe

__,_._,___

Nenhum comentário:

Postar um comentário

Hot Fox

segunda-feira, 14 de setembro de 2009

Re: ]] XL-mania [[ Sekali lagi : mensederhanakan fungsi

Nenhum comentário:

Arquivo do blog