Messages In This Digest (3 Messages)

1a.: Re: Makro mengekstraksi data vertikal menjadi data horizontal From: Kid Mr.

2a.: Re: Entry data dengan satu form From: i Haps
2b.: Re: Entry data dengan satu form From: i Haps

Messages

1a.: Re: Makro mengekstraksi data vertikal menjadi data horizontal

Posted by: "Kid Mr." mr.nmkid@gmail.com nmkid.family@ymail.com

Thu Feb 2, 2012 11:33 pm (PST)

Coba routine berikut :
Public Sub Ekstarksi()
Dim rng As Range, rngData As Range, rngItem As Range, rngTarget As Range
Dim lItem As Long

Application.ScreenUpdating = False
ActiveSheet.AutoFilterMode = False

'buat header jika belum punya header dengan teks mydata
If InStr(Range("a1").Value, "mydata") = 0 Then
Rows("1:1").Insert Shift:=xlDown
Range("A1").Value = "mydata"
End If

Set rngData = Range("a1").CurrentRegion 'init
range data
rngData.Sort Range("a1"), xlAscending, Header:=xlYes 'sort
data

'ekstrak kriteria ke kolom C
rngData.TextToColumns Range("c1"), xlFixedWidth,
FieldInfo:=Array(Array(0, 2), Array(11, 9))

Range("c1").CurrentRegion.RemoveDuplicates 1, xlYes 'remove
duplicate kriteria
Set rngItem = Range("c1").CurrentRegion.Offset(1) 'init range
item kriteria

Sheet2.Range("a1").CurrentRegion.EntireRow.Delete 'delete
hasil yang lama
Set rngTarget = Sheet2.Range("a1") 'init
anchor hasil yang baru

lItem = 0
rngData.AutoFilter
For Each rng In rngItem
If LenB(rng.Value) <> 0 Then
rngData.AutoFilter 1, rng.Value & "*"
rngData.SpecialCells(xlCellTypeVisible).Copy
rngTarget.Offset(, lItem).PasteSpecial xlPasteValues
lItem = lItem + 1
End If
Next
ActiveSheet.AutoFilterMode = False

'finishing
rngItem.EntireColumn.Delete 'buang
kolom item kriteria
rngTarget.CurrentRegion.Resize(1).EntireRow.Delete 'buang
header hasil
rngData.Resize(1).EntireRow.Delete 'buang
header data

Application.ScreenUpdating = True
MsgBox "Done."
End Sub

Regards,
Kid.

2012/2/3 andri apriyadi <andreemobile@yahoo.co.id>

> **
>
>
> Salam Para Pakar Excel
>
> Jika dengan menggunakan tombol Makro, bagaimana mengekstraksi deretan data
> vertikal menjadi data berbentuk horizontal (menyamping) sesuai dengan
> kategorinya?
>
> Contoh kasus ada dalam lampiran. Terima Kasih atas bantuannya.
>
> Regards
>
>
> Andree
>
>
>
>

Back to top
Reply to sender | Reply to group | Reply via web post
Messages in this topic (2)

2a.: Re: Entry data dengan satu form

Posted by: "i Haps" hapsari.stlizbeth@gmail.com liz_indri_haps

Thu Feb 2, 2012 11:46 pm (PST)

Lah,.. bisa bangett..!

Private Sub CmdSIMPAN_Click()
' coded by ibu Hapsah, penjual gado² gang sebelah
-------------------------------------------------
Dim NewRec As Range, oCtr As MSForms.Control
If Not Cbo_Daerah.Value = vbNullString Then
Set NewRec = Sheets(Cbo_Daerah.Value).Cells(1)
Set NewRec = NewRec(Rows.Count, 1).End(xlUp).Offset(1, 0)
With FORMDATA
NewRec(1, 1) = .txt_noagenda
NewRec(1, 2) = DateValue(.txt_Tgl_Masuk)
NewRec(1, 3) = .txt_nopengantar
NewRec(1, 4) = DateValue(.txt_Tgl_Pngntar)
NewRec(1, 5) = CDbl(.txt_jumlah)
NewRec(1, 6) = .Cbo_Daerah
NewRec(1, 7) = .txt_nopengantar_hg
NewRec(1, 8) = .txt_pertimbangan
NewRec(1, 9) = DateValue(.txt_Tgl_Acc)
NewRec(1, 10) = CDbl(.txt_MS)
NewRec(1, 11) = CDbl(.txt_BTL)
NewRec(1, 12) = CDbl(.txt_TMS)
For Each oCtr In .Controls
If TypeName(oCtr) = "TextBox" _
Then oCtr = vbNullString
Next oCtr
.Cbo_Daerah.ListIndex = -1
End With
Else
MsgBox "Daerah belum diterntukan !"
End If
End Sub
'------------------------------------

( trus... biar keren 'dikitts.., pengisian Data Tanggal ( ada tiga TextBox)
dikerjakan dengan
*Control Calender, yg dibuat terpisah (dengan Userform tersendiri). *
UserForm berisi Calendar terpanggil ostosmastis manakala TEXTBOX (yg ingin
diisi data
tanggal) *di-DOUBLE-CLICK*

*Userform Kalender ini "agak dicerdaskan" dengan perilaku spt ini:*

** Jika textbox = kosong, maka ketika di dobel-klik akan diisi TGL-HARI INI.
(anda masih tetap diberi kesempatan mengubah dengan mengklik TGL lain)

** Jika textbox sudah ada isinya (Text seperti Tanggal), maka ketika di
dobel-klik
isi data dibiarkan apa adanya ( dan anda masih bisa mengubah dengan tgl
lain)

** Jika di CANCEL, maka isi textbox akan dikembalikan seperti semula
(sebelum di klik)
(yaitu data yg dulu ada dikembalikan lagi, jika dulu kosong..? (YA
KOSONG kok repott!)

kindest regards,
- i -
*
*
*

*
*2012/2/2 herdin Sagala <herdins@yahoo.com>
*
>
> * *
>
> *para master yang terhormat saya mohon bantuannya atas masalah excel ini
> Permasalahan
> 1. bisa ngga kita input data dalam 1 form untuk sheet berbeda langsung
> masuk ke sheet sesuai dengan daerah masing2
>
> 2. untuk data MS,BTL,TMS kita buat setiap di entry akan menambah dengan
> jumlah yang ada, karena per agenda bisa di kerjakana beberapa hari,
> sehingga tidak langsung selesai saat itu jg, misal jumlah masuknya 100
> hari pertama di kerjakan/ entry MS 30,BTL 2, TMS 5, hari kedua dikerjakan
> untuk sisanya MS 50, BTL 3, TMS 10 maka total 100 balanca sama jumlah
> masuk
>
> 3. untuk laporan jumlah di ambil dari masing2 jumlah kolom pada sheet yang
> ada
>
> bagaimana code macronya ?
> terima kasih.*
>

Back to top
Reply to sender | Reply to group | Reply via web post
Messages in this topic (4)
2b.: Re: Entry data dengan satu form

Posted by: "i Haps" hapsari.stlizbeth@gmail.com liz_indri_haps

Fri Feb 3, 2012 12:18 am (PST)

maap, koreksi dikit...
makro itu sebelumnya ditulis di Module-Standard; dan ketika dipindah ke
Module UserForm "FORMDATA" harusnya ada keywords yg bisa dihilangkan,
TAPI LUPPAA.. (walaupun tetap jalan mulus..)

Setelah diringkas menjadi spt ini

Private Sub CmdSIMPAN_Click()
' coded by ibu Hapsah, penjual gado² gang sebelah
' ------------------------------------
Dim NewRec As Range, oCtr As MSForms.Control
If Not Cbo_Daerah.Value = vbNullString Then
Set NewRec = Sheets(Cbo_Daerah.Value).Cells(1)
Set NewRec = NewRec(Rows.Count, 1).End(xlUp).Offset(1, 0)
NewRec(1, 1) = txt_noagenda
NewRec(1, 2) = DateValue(txt_Tgl_Masuk)
NewRec(1, 3) = txt_nopengantar
NewRec(1, 4) = DateValue(txt_Tgl_Pngntar)
NewRec(1, 5) = CDbl(txt_jumlah)
NewRec(1, 6) = Cbo_Daerah
NewRec(1, 7) = txt_nopengantar_hg
NewRec(1, 8) = txt_pertimbangan
NewRec(1, 9) = DateValue(txt_Tgl_Acc)
NewRec(1, 10) = CDbl(txt_MS)
NewRec(1, 11) = CDbl(txt_BTL)
NewRec(1, 12) = CDbl(txt_TMS)
For Each oCtr In Controls
If TypeName(oCtr) = "TextBox" _
Then oCtr = vbNullString
Next oCtr
Cbo_Daerah.ListIndex = -1
Else
MsgBox "Daerah belum diterntukan !"
End If
End Sub
'-----------

Oh tadi lupa bilang, *TextBox* "DAERAH" buatan Herdin kita ubah menjadi*ComboBox
*
Dan Si Combo ini ketika Userform mendapat event Init, diisi dengan daftar
Sheet
selain Sheet "LAPORAN". Nantinya nama nama Daerah tidak perlu diketikkan,
hanya
perlu dipilih dari DropDownList milik si Combo itu...

- iHaps -

*
*
*2012/2/3 i Haps <hapsari.stlizbeth@gmail.com>
*
>
> *Lah,.. bisa bangett..!*
> *
> *
> *( trus... biar keren 'dikitts.., pengisian Data Tanggal ( ada tiga
> TextBox) dikerjakan dengan *
> *Control Calender, yg dibuat terpisah (dengan Userform tersendiri). *
> *UserForm berisi Calendar terpanggil ostosmastis manakala TEXTBOX (yg
> ingin diisi data *
> *tanggal) di-DOUBLE-CLICK*
> *
> *
> *Userform Kalender ini "agak dicerdaskan" dengan perilaku spt ini:*
> *
> *
> *** Jika textbox = kosong, maka ketika di dobel-klik akan diisi TGL-HARI
> INI.*
> * (anda masih tetap diberi kesempatan mengubah dengan mengklik TGL lain)*
> *
> *
> *** Jika textbox sudah ada isinya (Text seperti Tanggal), maka ketika di
> dobel-klik *
> * isi data dibiarkan apa adanya ( dan anda masih bisa mengubah dengan
> tgl lain)*
> *
> *
> *** Jika di CANCEL, maka isi textbox akan dikembalikan seperti semula
> (sebelum di klik)*
> * (yaitu data yg dulu ada dikembalikan lagi, jika dulu kosong..? (YA
> KOSONG kok repott!)*
> *
> *
> *kindest regards,*
> *- i - *
> *
> *
>

Back to top
Reply to sender | Reply to group | Reply via web post
Messages in this topic (4)

Create New Topic | Visit Your Group on the Web

Messages

---------------------------------------------------------------------
bergabung ke milis (subscribe), kirim mail kosong ke:
belajar-excel-subscribe@yahoogroups.com

posting ke milis, kirimkan ke:
belajar-excel@yahoogroups.com

berkunjung ke web milis
http://tech.groups.yahoo.com/group/belajar-excel/messages

melihat file archive / mendownload lampiran
http://www.mail-archive.com/belajar-excel@yahoogroups.com/
atau (sejak 25-Apr-2011) bisa juga di :
http://milis-belajar-excel.1048464.n5.nabble.com/

menghubungi moderators & owners: belajar-excel-owner@yahoogroups.com

keluar dari membership milis (UnSubscribe):
kirim mail kosong ke belajar-excel-unsubscribe@yahoogroups.com
---------------------------------------------------------------------

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

EXCEL FEED

Jumat, 03 Februari 2012

[belajar-excel] Digest Number 1501

Messages In This Digest (3 Messages)

Messages

Re: Makro mengekstraksi data vertikal menjadi data horizontal

Posted by: "Kid Mr." mr.nmkid@gmail.com nmkid.family@ymail.com

Thu Feb 2, 2012 11:33 pm (PST)

Re: Entry data dengan satu form

Posted by: "i Haps" hapsari.stlizbeth@gmail.com liz_indri_haps

Thu Feb 2, 2012 11:46 pm (PST)

Re: Entry data dengan satu form

Posted by: "i Haps" hapsari.stlizbeth@gmail.com liz_indri_haps

Fri Feb 3, 2012 12:18 am (PST)

Tidak ada komentar:

Posting Komentar

Followers

Blog Archive

About Me