Re: ]] XL-mania [[ klasifikasi jenis kelamin ke sheet yang berbeda sekaligus sort by date

 

bagian sortingnya itu ditulis dengan sintaks vba excel 2007
jika dijalankan di excel 2003 sering menimbulkan ellol message

berikut ini coding versi yg aman dijalankan di excel 2003

Sub PisahkanTabel(Kriteria As String)
   ' declaring...
   Dim dTabel As Range
   Dim dHasil As Range
   Dim r As Long
   Dim n As Long
  
   ' assignments...
   Set dTabel = Sheets("master").Range("A2").CurrentRegion.Offset(1, 0)
   Set dTabel = dTabel.Resize(dTabel.Rows.Count - 1, dTabel.Columns.Count)
   If Kriteria = "L" Then
      Set dHasil = Sheets("Laki-laki").Range("A4").CurrentRegion
   ElseIf Kriteria = "P" Then
      Set dHasil = Sheets("Perempuan").Range("A4").CurrentRegion
   End If
   dHasil.Offset(1, 0).ClearContents
   Set dHasil = dHasil(2, 1)
  
   ' posting...
   For n = 1 To dTabel.Rows.Count
      If dTabel(n, 3) = Kriteria Then
         dTabel(n, 1).Resize(1, dTabel.Columns.Count).Copy
         r = r + 1
         dHasil(r, 1).PasteSpecial xlPasteValuesAndNumberFormats
      End If
   Next n
   Application.CutCopyMode = False
   Set dHasil = dHasil.CurrentRegion
  
   ' sorting... (sintaks vba Excel versi 2003 )
   dHasil.Sort _
      Key1:=dHasil.Cells(1), _
      Order1:=xlAscending, _
      Header:=xlYes, _
      OrderCustom:=1, _
      MatchCase:=False, _
      Orientation:=xlTopToBottom
  
   dHasil(1).Select
End Sub

On Mon, Jan 31, 2011 at 11:58 AM, STDEV(i) <setiyowati.devi@gmail.com> wrote:

kalo boleh pakai makro, salah satu codingnya mungkin spt ini


Sub PisahkanTabel(Kriteria As String)
   ' declaring
   Dim dTabel As Range
   Dim dHasil As Range
   Dim r As Long
   Dim n As Long
  
   ' assignments...
   Set dTabel = Sheets("master").Range("A2").CurrentRegion.Offset(1, 0)
   Set dTabel = dTabel.Resize(dTabel.Rows.Count - 1, dTabel.Columns.Count)
   If Kriteria = "L" Then
      Set dHasil = Sheets("Laki-laki").Range("A4").CurrentRegion
   ElseIf Kriteria = "P" Then
      Set dHasil = Sheets("Perempuan").Range("A4").CurrentRegion
   End If
   dHasil.Offset(1, 0).ClearContents
   Set dHasil = dHasil(2, 1)
  
   ' posting
   For n = 1 To dTabel.Rows.Count
      If dTabel(n, 3) = Kriteria Then
         dTabel(n, 1).Resize(1, dTabel.Columns.Count).Copy
         r = r + 1
         dHasil(r, 1).PasteSpecial xlPasteValuesAndNumberFormats
      End If
   Next n
   Application.CutCopyMode = False
   Set dHasil = dHasil.CurrentRegion
  
   ' sorting
   With dHasil
      .CurrentRegion.Select
      .Parent.Sort.SortFields.Clear
      .Parent.Sort.SortFields.Add _
         Key:=Range("A4"), _
         SortOn:=xlSortOnValues, _
         Order:=xlAscending, _
         DataOption:=xlSortNormal
      With .Parent.Sort
         .SetRange dHasil
         .Header = xlYes
         .MatchCase = False
         .Orientation = xlTopToBottom
         .SortMethod = xlPinYin
         .Apply
      End With
   End With
  
End Sub

kalau ndak boleh, ya tinggal dihapus saja...

__._,_.___

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

Messages in this topic (4)

Recent Activity:

• New Members 94

Visit Your Group

+-:: XL-mania ::::::::::::::::::::----------------------------------+
| "if you are the most valuable assets, you will show up on the     |
| balance sheet..." - oNo Wiqe                                      |
| 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

.

__,_._,___