Senin, 12 November 2012

[belajar-excel] Digest Number 1900

3 New Messages

Digest #1900

Messages

Mon Nov 12, 2012 4:10 am (PST) . Posted by:

"Jan Raisin"

maaf, lampirannya ketinggalan xixixixi :D

Jan Raisin

>
> Pada 12 November 2012 04:49, dhen.baguse <bagusejogja@yahoo.com> menulis:
>
> **
>>
>>
>> salam para master,
>>
>> saya mencoba tanya mengenai masalah yang tidak jauh dari sebelumnya. File
>> saya lampirkan garis besarnya bagaimana cara membuat makro atau vba jika
>> tombol "Distribusi ke sheet masing-masing" diklik, kolom J - R (warna
>> merah) pindah sesmua sheet yang tersedia (seperti sheet yang sudah ada).
>> jika di kolom J - R tertulis "D/K" nanti mengisikan dikolom debit dan
>> kredit ke sheet yang tertera diatas(warna merah), jika "D" menggisikan di
>> kolom Debit atau "K" menggisikan di kolom Kredit ke sheet yang tertera
>> di atas dan jika terisi "0" tidak dipindahkan ke sheet.
>>
>> Mohon bantuannya dan pencerahan para master excel.
>>
>>
>>
>
>

Mon Nov 12, 2012 4:12 am (PST) . Posted by:

"Jan Raisin"

mas den bagus yang katanya paling bagus se-Jogja xixixixi :D,

Jan coba kasih solusi ya.. tapi belum tentu solusi yang optimal karena Jan
bukanlah programer, hanya sekedar tertarik dengan Excel.
pertama-tama Jan ubah dulu semua tabel di setiap sheet agar antara header
dengan data tidak dipisah dengan baris kosong,
kedua, Jan melakukan penambahan 1 sheet dengan nama Kas karena ternyata di
sheet Input yang dimerahin ada nama sheet Kas di kolom K
ketiga, Jan mengubah nama sheet "Lain lain" menjadi "Lain" agar sesuai
dengan nama sheet yang tercantum di cell R7 sheet Input

kode berikut di tulis dalam sebuah modul VBA, untuk menampilkannya tekan
F11, pilih Insert >> Module

Option Explicit
' ---------------------------- '
' Code by Jan Raisin '
' untuk millis Belajar Excel '
' 12 November 2012 '
' ---------------------------- '
' nama prosedur
Sub DistKeSheet()
' deklarasi header Tanggal, range Tanggal, & cell Tanggal
' tipe data adalah range karena yang akan diambil adalah object-nya
Dim hdTgl, rgTgl, cTgl As Range

' deklarasi varabel untuk menyimpan nomor baris data
' tipe data adalah long integer (Long) agar dapat memuat nilai yang
sangat besar
Dim rData, c As Long

' deklarasi variabel untuk menyimpan nama sheet
' tipe data adalah string karena akan digunakan menyimpan data berupa
text / string
Dim NamaSheet As String

' deklarasi variabel untuk menyimpan saldo akhir
' tipe data adalah dobel untuk mengantisipasi nilai dalam bentuk desimal
Dim Saldo As Double

' non-aktifkan fitur screen update agar vba berjalan lebih cepat
Application.ScreenUpdating = False

' pertama, aktifkan sheet input
Sheets("Input").Select

' tentukan lokasi header untuk tanggal
' letaknya di sheet input cell b8
Set hdTgl = Sheets("Input").Range("b8")

' tentukan lokasi range tanggel
' letaknya 1 baris di bawah header
' sampai dengan baris terakhir yang berisi data
Set rgTgl = Range(hdTgl.Offset(1, 0), hdTgl.End(xlDown))

' lakukan loop terhadap range tanggal
For Each cTgl In rgTgl

' ambil nilai baris dari setiap tanggal dengan menggunakan perintah
.Row
rData = cTgl.Row

' lakukan loop untuk kolom J (kolom nomer 10) sampai R (kolom
nomer 18)
For c = 10 To 18

' periksa kondisi apakah perpotongan antara baris & kolom
bernilai 0 (nol) atau tidak
If Cells(rData, c).Value <> 0 Then

' jika perpotongan baris & kolom <> 0 (nol)
' ambil nilai di baris 7 pada kolom tersebut
menggunakan perintah .Value
' cara menunjuknya adalah menggunakan perintah Cells(7,
c)
' nilai ini adalah nama setiap sheet yang akan menerima
distribusi data
' dan disimpan dalam variabel yang bernama NamaSheet
NamaSheet = Cells(7, c).Value

' panggil sheet tersebut sesuai dengan namanya
Sheets(NamaSheet).Select

' pergi ke cell B10, karena ini adalah header tanggal
dari setiap sheet
Range("b10").Select

' periksa apakah 1 baris di bawah header tanggal
tersebut ada datanya atau tidak
If ActiveCell.Offset(1, 0) = "" Then

' jika 1 baris di bawah header tidak ada datanya,
maka
' dari header turun 1 baris ke bawah menggunakan
perintah .Offset(1, 0)
ActiveCell.Offset(1, 0).Select

' karena ini adalah data pertama, maka
' beri nilai 1 pada kolom nomer bukti
' letaknya adalah 1 kolom di sebelah kanan dari
cell yang aktif
' untuk menunjuk lokasinya menggunakan perintah
.Offset(, 1)
ActiveCell.Offset(, 1).Value = 1

' selain itu
Else

' kalo sampai di sini, berarti di sheet tersebut
sudah ada datanya
' dari header turun ke data yang paling bawah
menggunakan perintah .End(xlDown)
' lalu turun lagi 1 baris ke baris yang kosong
dengan menggunakan perintah .Offset(1, 0)
ActiveCell.End(xlDown).Offset(1, 0).Select

' karena sebelumnya sudah ada data, maka nomer
bukti adalah
' nomer bukti pada baris di atasnya ditambah dengan
nilai 1
ActiveCell.Offset(, 1).Value =
ActiveCell.Offset(-1, 1).Value + 1

' yang ini adalah akhir dari pemeriksaan apakah di
sheet yang dituju sudah ada datanya atau belum
End If

' mulai dari sini kita akan bekerja dengan cell yang
aktif pada sheet yang sudah terpilih
' untuk itu selalu dibuka dengan perintah With
nama_object
' dan selalu ditutup dengan End With
With ActiveCell

' pada aktif cell diisi dengan tanggal
' nilainya berasal dari sheet Input, terletak pada
perpotongan baris dengan kolom 2 (kolom B)
.Value = Sheets("Input").Cells(rData, 2).Value

' 2 kolom di sebelah kanan aktif cell diisi dengan
nilai yang berasal dari
' perpotongan antara baris dengan kolom (mulai
kolom 10 atau kolom J sampai kolom 18 atau kolom R)
.Offset(, 2).Value = Sheets("Input").Cells(rData,
c).Value

' 3 kolom di sebelah kanan aktif cell diisi dengan
Uraian Transaksi
' nilainya berasal dari sheet Input, terletak pada
perpotongan baris dengan kolom 5 (kolom E)
.Offset(, 3).Value = Sheets("Input").Cells(rData,
5).Value

' sekarang kita melakukan pengujian data terhadap
kode yang tercantum dalam kolom nama baris
' dan perpotongan baris tanggal
' kondisi pertama jika kode adalah D/K
If Sheets("Input").Cells(rData, c) = "D/K" Then

' maka nilai kolom Masuk & kolom Keluar pada
sheet yang terpilih
' diisi dengan nilai yang berasal dari kolom
Jumlah pada sheet Input
' untuk menunjuk kolom masuk yang terletak 4
kolom di sebelah kanan cell aktif
' menggunakan perintah .Offset(, 4)
.Offset(, 4).Value =
Sheets("Input").Cells(rData, 8).Value

' untuk menunjuk kolom masuk yang terletak 5
kolom di sebelah kanan cell aktif
' menggunakan perintah .Offset(, 5)
.Offset(, 5).Value =
Sheets("Input").Cells(rData, 8).Value

' lakukan pengujian dengan kondisi berikutnya yaitu
kode adalah D
ElseIf Sheets("Input").Cells(rData, c) = "D" Then

' pada kondisi ini yang diisi dengan nilai
adalah kolom Masuk
.Offset(, 4).Value =
Sheets("Input").Cells(rData, 8).Value

' sedangkan kolom keluar diisi dengan nilai 0
(nol)
.Offset(, 5).Value = 0

' selain itu, berarti kode adalah K
Else

' pada kondisi ini kolom Masuk diisi dengan 0
(nol)
.Offset(, 4).Value = 0

' sedangkan kolom Keluar diisi dengan nilai
yang berasal dari sheet Input
.Offset(, 5).Value =
Sheets("Input").Cells(rData, 8).Value

' ini adalah penutup dari pengecekan kode
End If

' sekarang dilakukan pengujian untuk menenukan
nilai Saldo Akhir
' jika cell aktif ada di baris 11, berarti ini
adalah data pertama
If ActiveCell.Row = 11 Then

' maka Saldo akhir adalah nilai pada cell H7 +
F11 - G11
Saldo = Range("h7").Value + Range("f11").Value
- Range("g11").Value

' selain itu, berarti ini bukanlah data pertama
Else

' nilai Saldo akhir berasal dari saldo akhir
pada 1 baris di atasnya
' letaknya adalah 1 baris di atas cell aktif
' dan 6 kolom di sebelah kanan cell aktif
' untuk menunjuknya digunakan perintah
.Offset(-1, 6)
' ditambah nilai pada kolom Masuk
' letaknya 4 kolom di sebelah kanan cell aktif
' untuk menunjuknya digunakan perintah
.Offset(, 4)
' dikurangi nilai kolom Keluar
' letaknya 5 kolom di sebelah kanan cell aktif
' untuk menunjuknya digunakan perintah
.Offset(, 5)
Saldo = .Offset(-1, 6).Value + .Offset(,
4).Value - .Offset(, 5).Value

' ini adalah penutup dari perhitungan Saldo Akhir
End If

' pada cell H8 & kolom Saldo diisi dengan nilai
Saldo Akhir yang sudah diperoleh sebelumnya
Range("h8").Value = Saldo
.Offset(, 6).Value = Saldo

' ini adalah penutup dari blok With ActiveCell
End With

' ini adalah penutup dari blok pemeriksaan kode transaksi
End If

' panggil kembali sheet Input
Sheets("Input").Select

' periksa kolom berikutnya
Next c

' periksa baris tanggal berikutnya
Next cTgl

' aktifkan kembali fitur screen update
Application.ScreenUpdating = True

' ini adalah akhir dari prosedur Distribusi ke setiap sheet
End Sub

lalu kode tersebut di-assign dengan tombol yang sudah ditentukan

semoga cerita yang sangat panjang ini dapat menjadi pembuka bagi Jan
berbagi bersama member millis ini.

Best Regard,

Jan Raisin

Pada 12 November 2012 04:49, dhen.baguse <bagusejogja@yahoo.com> menulis:

> **
>
>
> salam para master,
>
> saya mencoba tanya mengenai masalah yang tidak jauh dari sebelumnya. File
> saya lampirkan garis besarnya bagaimana cara membuat makro atau vba jika
> tombol "Distribusi ke sheet masing-masing" diklik, kolom J - R (warna
> merah) pindah sesmua sheet yang tersedia (seperti sheet yang sudah ada).
> jika di kolom J - R tertulis "D/K" nanti mengisikan dikolom debit dan
> kredit ke sheet yang tertera diatas(warna merah), jika "D" menggisikan di
> kolom Debit atau "K" menggisikan di kolom Kredit ke sheet yang tertera
> di atas dan jika terisi "0" tidak dipindahkan ke sheet.
>
> Mohon bantuannya dan pencerahan para master excel.
>
>
>

Mon Nov 12, 2012 6:18 am (PST) . Posted by:

"ghozi alkatiri" ghozialkatiri

coba kirimkan lampiran contoh riil dari kasus yang dimaksud

wassalam

Ghozi Alkatiri

________________________________
Dari: "the_x_mikey@yahoo.com" <the_x_mikey@yahoo.com>
Kepada: belajar-excel@yahoogroups.com
Dikirim: Senin, 12 November 2012 16:13
Judul: Re: Bls: [belajar-excel] Index berurutan berdasarkan kriteria tertentu


 
Hi pak zainul dan pak Ghozi,

Rumus yang kalian berikan berjalan baik dalam kasus yang saya sebutkan.
Tapi saya lupa kalau tiap provider mempunyai bukan hanya 1 tipe 4 angka didepan (berarti acuan di A1 tidak bisa dipakai). Saya sudah mencoba fungsi or("0812","0811","0813","0852","0853","0821","0822","0831") tapi tidak bisa. Apa harus bikin index bantuan?
________________________________

From: ghozi alkatiri <ghozialkatiri@yahoo.co.id>
Sender: belajar-excel@yahoogroups.com
Date: Mon, 12 Nov 2012 15:19:08 +0800 (SGT)
To: belajar-excel@yahoogroups.com<belajar-excel@yahoogroups.com>
ReplyTo: belajar-excel@yahoogroups.com
Subject: Bls: [belajar-excel] Index berurutan berdasarkan kriteria tertentu
 
formula  pertama ditulis di D2 sheet mentari (formula array)

{=IFERROR(INDEX('no tlp'!$A$2:$A$18;SMALL(IF(LEFT('no tlp'!$A$2:$A$18;4)=$A$1;MATCH('no tlp'!$A$2:$A$18;'no tlp'!$A$2:$A$18;0));ROW(1:1)));"")}

copy ke bawah

selanjutnya formula bisa dicopy ke sheet lainnya karena referensi cellnya sama

wassalam

Ghozi Alkatiri

________________________________
Dari: "the_x_mikey@yahoo.com" <the_x_mikey@yahoo.com>
Kepada: belajar-excel@yahoogroups.com
Dikirim: Senin, 12 November 2012 11:21
Judul: [belajar-excel] Index berurutan berdasarkan kriteria tertentu


 
Hi all,

Saya mau memisahkan list no telepon ke sheet terpisah dengan kriteria 4 angka depan.
Udah coba index match dan countif tp belum bisa. Tolong dibantu ya

GROUP FOOTER MESSAGE
---------------------------------------------------------------------
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
---------------------------------------------------------------------
Diposting oleh EXCEL FEED LEARNING di 09.59

Tidak ada komentar:

Posting Komentar

Langganan: Posting Komentar (Atom)