Re: ]] XL-mania [[ Record macro Sederhana

 

Tunjek poin saja...

(1)

Cara (1) ini tidak dengan menghapus KOLOM / BARIS yg kosong; tetapi menyaring RECORDS  yg "tidak kosong", atau cell pertamanya "Tidak Date" atau cell pertamanya "Tidak Wilayah".

Tetapi sebelumnya harus dicari cara untuk mengidentifikasi RANGE yg SEBENARNYA TERPAKAI di sheet itu.  (Anda semua tahu bahwa UsedRange tidak selalu cocok dengan kemauan; penjelasannya agak panjang; jadi kita cuekin dulu)

Sedangkan  method  End(xlDown / xlToRight)  terbatas pada data yg contigous saja, demmikian juga dengan CurrentRegion.

Jadi kesimpulannya: UsedRange, End(xlArah) dan CurrentRegion, tidak memenuhi spesifikasi yg kita harapkan dlm mendeksi Range yg LIAR,  range yg dibuat tanpa mengindahkan kaidah database, range yg dibuat dengan semauk-mauknya..!

Di sini, kita mencoba meraba range YG SEBENARNYA TERPAKAI dengan fungsi ctvDataArea (fungsi 'bikinan' dalam negeri, dijual dengan kondisi : "Loentoer Tidak Ditanggung" !! hi hi...)

Penjelasan coding sepertinya tidak diperlukan karena ini hanyalah makro sederhana; tidak mengandung hal hal baru atau rumit..

Sub YaaaaaGituDeh()

   Dim Sumber As Range, NewTbl As Range

   Dim n As Long, r As Long, c As Integer, k As Integer

   Set Sumber = ctvDataArea(ActiveSheet)

   Set Sumber = Sumber.Resize(Sumber.Rows.Count, 7)

   Set NewTbl = Sumber.Offset(2, Sumber.Columns.Count + 4)

   NewTbl.ClearContents

   For n = 1 To Sumber.Rows.Count

      If Not Sumber(n, 1) = vbNullString Then

         If Not LCase(Sumber(n, 1)) = "date" Then

            If LCase(Sumber(n, 1)) = "wilayah" Then

               If r = 0 Then

                  For c = 1 To Sumber.Columns.Count

                     If Not Sumber(n, c) = vbNullString Then

                        k = k + 1

                        NewTbl(0, k) = Sumber(n, c)

                     End If

                  Next c

               End If

            Else

               r = r + 1: k = 0

               For c = 1 To Sumber.Columns.Count

                  If Not Sumber(n, c) = vbNullString Then

                     k = k + 1

                     NewTbl(r, k) = Sumber(n, c)

                  End If

               Next c

            End If

         End If

      End If

   Next n

   Set NewTbl = NewTbl.CurrentRegion

   NewTbl.EntireColumn.AutoFit

End Sub

(2)

Cara ke (2) : menghapusi  (bukan "ngapusi" lho!) kolom-kolom kosong yg berada DI DALAM Tabel; kemudian juga menghapusi baris-baris yg kosong, dan juga baris-baris yg mengandung kata "wilayah" maupun kata "date" (kecuali pada baris tertentu).

Demi keakuratan pendeteksian (otomatis)  letak & dimensi tabel yg akan dirujuk, makro ini juga memerlukan fungsi buatan dalam negeri: ctvDataArea  (boleh dipakai di aplikasi -aplikasi anda asal menyadari bahwa kondisinya = "loentoer tidak ditanggung")

Ulasan mengenai Fungsi yang bisa Loentoer ini, dan mengapa harus dibuat  untuk menggantikan kelemahan UsedRange / Ex(xlArah) / Currentregion, insyaallah akan dibahas dlm tulisan tersendiri dlm satu dua hari ini.; kalau siti tidak lupa..)

Makro ini, seperti makro cara (1), sangat mengandalkan bentuk tabel yg akan diolah terutama pada 2 baris pertama harus persis seperti contoh yg diajukan. (deskripsi Tanggal  dan Heading Kolom)

Sub Begitulah_Kira_Kira()

   ' menghilangkan kolom kosong dan row kosong di dalam tabel

   ' menghilangkan row dengan syarat tertentu di dalam tabel

   ' siti Vi // 26 jun 2011

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

   Dim RNG As Range, r As Long, brss As Long

   Dim c As Integer, kols As Integer

   Set RNG = ctvDataArea(ActiveSheet)

   brss = RNG.Rows.Count

   kols = RNG.Columns.Count

   For r = brss To 1 Step -1

      If WorksheetFunction.CountA(RNG(r + 1, 1).Resize(1, kols)) = 0 Then

         RNG(r + 1, 1).Resize(1, kols).Delete Shift:=xlUp

      End If

      If LCase(RNG(r + 1, 1)) = "date" Or _

         LCase(RNG(r + 1, 1)) = "wilayah" Then

         If r > 1 Then

         RNG(r + 1, 1).Resize(1, kols).Delete Shift:=xlUp

         End If

      End If

   Next r

   For c = kols To 1 Step -1

      If WorksheetFunction.CountA(RNG(1, c + 1).EntireColumn) = 0 Then

         RNG(1, c + 1).EntireColumn.Delete

      End If

   Next c

   RNG(1).Resize(1, kols).ClearContents

End Sub

2011/6/26 $martin <p0443dv@gmail.com>
>
> Dear Pakar Excel,
>
> Saya memiliki problem record macro sederhana, yaitu menghapus beberapa kolom.
> Namun karena jumlah baris yang saya gunakan berubah-ubah sering ada data yang tidak ikut ter-convert.
>
> Mohon bantuan dari pakar excel sekalian atas bantuannya terima kasih

>

__._,_.___

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

Messages in this topic (3)

Recent Activity:

• New Members 64
• New Polls 1

Visit Your Group

+-:: XL-mania ::::::::::::::::::::----------------------------------+
| tiap tanggal gajian, order buku "mengapa boss benci chart anda    |
| membludak :) ayo2 pesan yang belum punya....                      |
| 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              |
+-------------------------------------------------------------------+

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

.

__,_._,___