Quantcast

[belajar-excel] solusi dengan filter, formula atau macro

classic Classic list List threaded Threaded
9 messages Options
Reply | Threaded
Open this post in threaded view
|  
Report Content as Inappropriate

[belajar-excel] solusi dengan filter, formula atau macro

LA27
Dear master Excel,

Assalamu'alaikum
Saya mengalami kesulitan agar bisa mempercepat pekerjaan saya ( file terlampir).
Agar Analisa yang tidak kepakai tidak muncul, atau otomatis kehiden atau kefilter bagaimana??
yang mana mengacu pada volume di RAB.

tujuanya agar waktu di print analisa yang diperlukan saja yang muncul.

 
Mohon pencerahanya dan masukan dari Master.

 
Terima kasih sebelumnya,
Salam,
Luthfi

solusinya apa.xls (591K) Download Attachment
Kid
Reply | Threaded
Open this post in threaded view
|  
Report Content as Inappropriate

Re: [belajar-excel] solusi dengan filter, formula atau macro

Kid
Administrator
Waalaikumussalam Wr. Wb.

Aduh... filenya lebih dari 250KB. Lain kali diusahakan tidak lebih dari
250KB ya. hehehe... tadi salah pencet waktu moderasi. Layarnya terlalu
kecil relatif dibanding jemariku yang saingan dengan pisang besarnya...

btw, kalau pakai fitur autofilter dibantu 2 kolom bantu kira-kira ribet gak
? File terlampir contohnya.

Wassalamualaikum Wr. Wb.
Kid.



2012/10/16 luthfi amin <[hidden email]>

> **
>
>
> Dear master Excel,**
>
> **Assalamu'alaikum**
> Saya mengalami kesulitan agar bisa mempercepat pekerjaan saya ( file
> terlampir).
> Agar Analisa yang tidak kepakai tidak muncul, atau otomatis kehiden atau
> kefilter bagaimana??
> yang mana mengacu pada volume di RAB.
>
> tujuanya agar waktu di print analisa yang diperlukan saja yang muncul.
>
>
> Mohon pencerahanya dan masukan dari Master.
> **
> ** **
> Terima kasih sebelumnya,****
> Salam,****
> Luthfi
>
>  
>

re-solusinya apa.xls (55K) Download Attachment
Reply | Threaded
Open this post in threaded view
|  
Report Content as Inappropriate

Re: [belajar-excel] solusi dengan filter, formula atau macro

LA27
This post has NOT been accepted by the mailing list yet.
waduh maaf master kid,filenya kegedean gak lihat,maklum baru jadi anggota..

dengan solusi sumproduct sudah sangat membantu,tapi analisa saya banyak master ada sekitar 650 analisa..

ada tidak formula atau macro yang lebih efektif??

trimakasih


Reply | Threaded
Open this post in threaded view
|  
Report Content as Inappropriate

Re: [belajar-excel] solusi dengan filter, formula atau macro

LA27
In reply to this post by LA27
waduh maaf master kid,filenya kegedean gak lihat,maklum baru jadi anggota.. 

dengan solusi sumproduct sudah sangat membantu,tapi analisa saya banyak master ada sekitar 650 analisa.. 

ada tidak formula atau macro yang lebih efektif?? 

trimakasih 
Reply | Threaded
Open this post in threaded view
|  
Report Content as Inappropriate

Re: [belajar-excel] solusi dengan filter, formula atau macro

aji mumpung
ikutan..
mungkin bukan solusi optimal, karena pake kolom bantu yang dijalankan
dengan macro hehehe
terakhir.. kolom bantunya dihapus lagi jadi di detail RAB bersih dari kolom
bantu

cara ini terinspirasi dari solusi Master Kid yang sebelumnya menawarkan
solusi dengan formula

codenya ditulis dalam sebuah modul dan dijalankan dengan menekan sebuah
tombol

Option Explicit
' ======================================
' coded by: Aji Mumpung
' terinspirasi dari formula master Kid
' kaki gunung merbabu, 17 Oktober 2012
' sambil angon kambing & nyari rumput
' ======================================
Sub AnalisaRAB()
    Dim hdIdAhsDtl, hdIdAhsRab As Range
    Dim idxRowDtl, idxRowAHS As Long
    Dim r, RecNo, Htg As Long

    Application.ScreenUpdating = False
    Set hdIdAhsDtl = Sheet2.Range("b9")
    If Sheet2.Range("b9").Value = "" Then
        MsgBox "Data detail ARB tidak ditemukan", vbOKOnly, "Pesan"
        Exit Sub
    End If
    Set hdIdAhsRab = Sheet1.Range("c6")
    idxRowAHS = Sheet1.Cells.SpecialCells(xlCellTypeLastCell).Row
    idxRowDtl = Sheet2.Cells.SpecialCells(xlCellTypeLastCell).Row
    For r = 9 To idxRowDtl
        Sheet2.Select
        If Cells(r, 2) = "" Then
            Cells(r, 11).Value = Cells(r - 1, 11).Value
            Else
            Cells(r, 11).Value = Cells(r - 1, 11).Value + 1
        End If
        If Cells(r - 1, 11).Value = Cells(r, 11).Value Then
            Cells(r, 12).Value = Cells(r - 1, 12).Value
            Else
            Cells(r, 12).Value =
Application.WorksheetFunction.Index(Range(Sheet1.Cells(6, 5),
Sheet1.Cells(idxRowAHS, 5)), _
                Application.WorksheetFunction.Match(Sheet2.Cells(r, 2),
Range(Sheet1.Cells(6, 3), Sheet1.Cells(idxRowAHS, 3)), 0))
        End If
        If Cells(r, 12).Value <> 0 Then
            Range(Cells(r, 2), Cells(r, 10)).Copy
            Sheet3.Select
            Range("c8").Select
            If ActiveCell.Offset(1, 0) = "" Then
                ActiveCell.Offset(1, -1).Select
                Else
                ActiveCell.End(xlDown).Offset(1, -1).Select
            End If
            ActiveCell.PasteSpecial (xlPasteValuesAndNumberFormats)
            Application.CutCopyMode = False
        End If
    Next r
    Sheet2.Select
    Range("k:l").Delete
    Application.ScreenUpdating = True
End Sub


wassalam,

-aji mumpung-
#lagi angon sambil cari rumput#

Pada 16 Oktober 2012 19:11, luthfi amin <[hidden email]> menulis:

> **
>
>
> waduh maaf master kid,filenya kegedean gak lihat,maklum baru jadi
> anggota..
>
> dengan solusi sumproduct sudah sangat membantu,tapi analisa saya banyak
> master ada sekitar 650 analisa..
>
> ada tidak formula atau macro yang lebih efektif??
>
> trimakasih
>
>  
>

re-solusinya apa.xlsb (35K) Download Attachment
Reply | Threaded
Open this post in threaded view
|  
Report Content as Inappropriate

[belajar-excel] Re: solusi dengan filter, formula atau macro

LA27
wah terim kasih banyak neh master aji,dikasih pencerahan dengan macro,cb saya pelajarin dulu..mohon bimbinganya master.

--- In [hidden email], aji mumpung <pupung1986@...> wrote:

>
> ikutan..
> mungkin bukan solusi optimal, karena pake kolom bantu yang dijalankan
> dengan macro hehehe
> terakhir.. kolom bantunya dihapus lagi jadi di detail RAB bersih dari kolom
> bantu
>
> cara ini terinspirasi dari solusi Master Kid yang sebelumnya menawarkan
> solusi dengan formula
>
> codenya ditulis dalam sebuah modul dan dijalankan dengan menekan sebuah
> tombol
>
> Option Explicit
> ' ======================================
> ' coded by: Aji Mumpung
> ' terinspirasi dari formula master Kid
> ' kaki gunung merbabu, 17 Oktober 2012
> ' sambil angon kambing & nyari rumput
> ' ======================================
> Sub AnalisaRAB()
>     Dim hdIdAhsDtl, hdIdAhsRab As Range
>     Dim idxRowDtl, idxRowAHS As Long
>     Dim r, RecNo, Htg As Long
>
>     Application.ScreenUpdating = False
>     Set hdIdAhsDtl = Sheet2.Range("b9")
>     If Sheet2.Range("b9").Value = "" Then
>         MsgBox "Data detail ARB tidak ditemukan", vbOKOnly, "Pesan"
>         Exit Sub
>     End If
>     Set hdIdAhsRab = Sheet1.Range("c6")
>     idxRowAHS = Sheet1.Cells.SpecialCells(xlCellTypeLastCell).Row
>     idxRowDtl = Sheet2.Cells.SpecialCells(xlCellTypeLastCell).Row
>     For r = 9 To idxRowDtl
>         Sheet2.Select
>         If Cells(r, 2) = "" Then
>             Cells(r, 11).Value = Cells(r - 1, 11).Value
>             Else
>             Cells(r, 11).Value = Cells(r - 1, 11).Value + 1
>         End If
>         If Cells(r - 1, 11).Value = Cells(r, 11).Value Then
>             Cells(r, 12).Value = Cells(r - 1, 12).Value
>             Else
>             Cells(r, 12).Value =
> Application.WorksheetFunction.Index(Range(Sheet1.Cells(6, 5),
> Sheet1.Cells(idxRowAHS, 5)), _
>                 Application.WorksheetFunction.Match(Sheet2.Cells(r, 2),
> Range(Sheet1.Cells(6, 3), Sheet1.Cells(idxRowAHS, 3)), 0))
>         End If
>         If Cells(r, 12).Value <> 0 Then
>             Range(Cells(r, 2), Cells(r, 10)).Copy
>             Sheet3.Select
>             Range("c8").Select
>             If ActiveCell.Offset(1, 0) = "" Then
>                 ActiveCell.Offset(1, -1).Select
>                 Else
>                 ActiveCell.End(xlDown).Offset(1, -1).Select
>             End If
>             ActiveCell.PasteSpecial (xlPasteValuesAndNumberFormats)
>             Application.CutCopyMode = False
>         End If
>     Next r
>     Sheet2.Select
>     Range("k:l").Delete
>     Application.ScreenUpdating = True
> End Sub
>
>
> wassalam,
>
> -aji mumpung-
> #lagi angon sambil cari rumput#
>
> Pada 16 Oktober 2012 19:11, luthfi amin <luthfie_27@...> menulis:
>
> > **
> >
> >
> > waduh maaf master kid,filenya kegedean gak lihat,maklum baru jadi
> > anggota..
> >
> > dengan solusi sumproduct sudah sangat membantu,tapi analisa saya banyak
> > master ada sekitar 650 analisa..
> >
> > ada tidak formula atau macro yang lebih efektif??
> >
> > trimakasih
> >
> >  
> >
>


Reply | Threaded
Open this post in threaded view
|  
Report Content as Inappropriate

[belajar-excel] Re: solusi dengan filter, formula atau macro

LA27
In reply to this post by aji mumpung
ini macro saya copikan di excel yang laen gak mau,saya kasih warna merah
peruntah yg gak mau jalan..mohon dibantu

> Sub AnalisaRAB()
> Dim hdIdAhsDtl, hdIdAhsRab As Range
> Dim idxRowDtl, idxRowAHS As Long
> Dim r, RecNo, Htg As Long
>
> Application.ScreenUpdating = False
> Set hdIdAhsDtl = Sheet2.Range("b9")
> If Sheet2.Range("b9").Value = "" Then
> MsgBox "Data detail ARB tidak ditemukan", vbOKOnly, "Pesan"
> Exit Sub
> End If
> Set hdIdAhsRab = Sheet1.Range("c6")
> idxRowAHS = Sheet1.Cells.SpecialCells(xlCellTypeLastCell).Row
> idxRowDtl = Sheet2.Cells.SpecialCells(xlCellTypeLastCell).Row
> For r = 9 To idxRowDtl
> Sheet2.Select
> If Cells(r, 2) = "" Then
> Cells(r, 11).Value = Cells(r - 1, 11).Value
> Else
> Cells(r, 11).Value = Cells(r - 1, 11).Value + 1
> End If
> If Cells(r - 1, 11).Value = Cells(r, 11).Value Then
> Cells(r, 12).Value = Cells(r - 1, 12).Value
> Else
> Cells(r, 12).Value =
> Application.WorksheetFunction.Index(Range(Sheet1.Cells(6, 5),
> Sheet1.Cells(idxRowAHS, 5)), _
> Application.WorksheetFunction.Match(Sheet2.Cells(r, 2),
> Range(Sheet1.Cells(6, 3), Sheet1.Cells(idxRowAHS, 3)), 0))
> End If
> If Cells(r, 12).Value <> 0 Then
> Range(Cells(r, 2), Cells(r, 10)).Copy
> Sheet3.Select
> Range("c8").Select
> If ActiveCell.Offset(1, 0) = "" Then
> ActiveCell.Offset(1, -1).Select
> Else
> ActiveCell.End(xlDown).Offset(1, -1).Select
> End If
> ActiveCell.PasteSpecial (xlPasteValuesAndNumberFormats)
> Application.CutCopyMode = False
> End If
> Next r
> Sheet2.Select
> Range("k:l").Delete
> Application.ScreenUpdating = True
> End Sub



--- In [hidden email], aji mumpung <pupung1986@...>
wrote:
>
> ikutan..
> mungkin bukan solusi optimal, karena pake kolom bantu yang dijalankan
> dengan macro hehehe
> terakhir.. kolom bantunya dihapus lagi jadi di detail RAB bersih dari
kolom
> bantu
>
> cara ini terinspirasi dari solusi Master Kid yang sebelumnya
menawarkan
> solusi dengan formula
>
> codenya ditulis dalam sebuah modul dan dijalankan dengan menekan
sebuah

> tombol
>
> Option Explicit
> ' ======================================
> ' coded by: Aji Mumpung
> ' terinspirasi dari formula master Kid
> ' kaki gunung merbabu, 17 Oktober 2012
> ' sambil angon kambing & nyari rumput
> ' ======================================
> Sub AnalisaRAB()
>     Dim hdIdAhsDtl, hdIdAhsRab As Range
>     Dim idxRowDtl, idxRowAHS As Long
>     Dim r, RecNo, Htg As Long
>
>     Application.ScreenUpdating = False
>     Set hdIdAhsDtl = Sheet2.Range("b9")
>     If Sheet2.Range("b9").Value = "" Then
>         MsgBox "Data detail ARB tidak ditemukan", vbOKOnly, "Pesan"
>         Exit Sub
>     End If
>     Set hdIdAhsRab = Sheet1.Range("c6")
>     idxRowAHS = Sheet1.Cells.SpecialCells(xlCellTypeLastCell).Row
>     idxRowDtl = Sheet2.Cells.SpecialCells(xlCellTypeLastCell).Row
>     For r = 9 To idxRowDtl
>         Sheet2.Select
>         If Cells(r, 2) = "" Then
>             Cells(r, 11).Value = Cells(r - 1, 11).Value
>             Else
>             Cells(r, 11).Value = Cells(r - 1, 11).Value + 1
>         End If
>         If Cells(r - 1, 11).Value = Cells(r, 11).Value Then
>             Cells(r, 12).Value = Cells(r - 1, 12).Value
>             Else
>             Cells(r, 12).Value =
> Application.WorksheetFunction.Index(Range(Sheet1.Cells(6, 5),
> Sheet1.Cells(idxRowAHS, 5)), _
>                 Application.WorksheetFunction.Match(Sheet2.Cells(r,
2),

> Range(Sheet1.Cells(6, 3), Sheet1.Cells(idxRowAHS, 3)), 0))
>         End If
>         If Cells(r, 12).Value <> 0 Then
>             Range(Cells(r, 2), Cells(r, 10)).Copy
>             Sheet3.Select
>             Range("c8").Select
>             If ActiveCell.Offset(1, 0) = "" Then
>                 ActiveCell.Offset(1, -1).Select
>                 Else
>                 ActiveCell.End(xlDown).Offset(1, -1).Select
>             End If
>             ActiveCell.PasteSpecial (xlPasteValuesAndNumberFormats)
>             Application.CutCopyMode = False
>         End If
>     Next r
>     Sheet2.Select
>     Range("k:l").Delete
>     Application.ScreenUpdating = True
> End Sub
>
>
> wassalam,
>
> -aji mumpung-
> #lagi angon sambil cari rumput#
>
> Pada 16 Oktober 2012 19:11, luthfi amin luthfie_27@... menulis:
>
> > **
> >
> >
> > waduh maaf master kid,filenya kegedean gak lihat,maklum baru jadi
> > anggota..
> >
> > dengan solusi sumproduct sudah sangat membantu,tapi analisa saya
banyak
> > master ada sekitar 650 analisa..
> >
> > ada tidak formula atau macro yang lebih efektif??
> >
> > trimakasih
> >
> >
> >
>

Reply | Threaded
Open this post in threaded view
|  
Report Content as Inappropriate

Re: [belajar-excel] Re: solusi dengan filter, formula atau macro

aji mumpung
bisa tolong di posting contoh wbknya.. >>> yang kode vbanya gak mau jalan..

cukup beberapa baris data saja, ukuran <250 kb

wassalam,

-aji mumpung-

Pada 18 Oktober 2012 11:35, luthfie_27 <[hidden email]> menulis:

> **
>
>
> ini macro saya copikan di excel yang laen gak mau,saya kasih warna merah
> peruntah yg gak mau jalan..
> mohon dibantu
>
> > Sub AnalisaRAB()
> > Dim hdIdAhsDtl, hdIdAhsRab As Range
> > Dim idxRowDtl, idxRowAHS As Long
> > Dim r, RecNo, Htg As Long
> >
> > Application.ScreenUpdating = False
> > Set hdIdAhsDtl = Sheet2.Range("b9")
> > If Sheet2.Range("b9").Value = "" Then
> > MsgBox "Data detail ARB tidak ditemukan", vbOKOnly, "Pesan"
> > Exit Sub
> > End If
> > Set hdIdAhsRab = Sheet1.Range("c6")
> > idxRowAHS = Sheet1.Cells.SpecialCells(xlCellTypeLastCell).Row
> > idxRowDtl = Sheet2.Cells.SpecialCells(xlCellTypeLastCell).Row
> > For r = 9 To idxRowDtl
> > Sheet2.Select
> > If Cells(r, 2) = "" Then
> > Cells(r, 11).Value = Cells(r - 1, 11).Value
> > Else
> > Cells(r, 11).Value = Cells(r - 1, 11).Value + 1
> > End If
> > If Cells(r - 1, 11).Value = Cells(r, 11).Value Then
> > Cells(r, 12).Value = Cells(r - 1, 12).Value
> > Else
> > Cells(r, 12).Value =
> > Application.WorksheetFunction.Index(Range(Sheet1.Cells(6, 5),
> > Sheet1.Cells(idxRowAHS, 5)), _
> > Application.WorksheetFunction.Match(Sheet2.Cells(r, 2),
> > Range(Sheet1.Cells(6, 3), Sheet1.Cells(idxRowAHS, 3)), 0))
> > End If
> > If Cells(r, 12).Value <> 0 Then
> > Range(Cells(r, 2), Cells(r, 10)).Copy
> > Sheet3.Select
> > Range("c8").Select
> > If ActiveCell.Offset(1, 0) = "" Then
> > ActiveCell.Offset(1, -1).Select
> > Else
> > ActiveCell.End(xlDown).Offset(1, -1).Select
> > End If
> > ActiveCell.PasteSpecial (xlPasteValuesAndNumberFormats)
> > Application.CutCopyMode = False
> > End If
> > Next r
> > Sheet2.Select
> > Range("k:l").Delete
> > Application.ScreenUpdating = True
> > End Sub
>
>
>
> --- In [hidden email], aji mumpung <pupung1986@...> wrote:
> >
> > ikutan..
> > mungkin bukan solusi optimal, karena pake kolom bantu yang dijalankan
> > dengan macro hehehe
> > terakhir.. kolom bantunya dihapus lagi jadi di detail RAB bersih dari
> kolom
> > bantu
> >
> > cara ini terinspirasi dari solusi Master Kid yang sebelumnya menawarkan
> > solusi dengan formula
> >
> > codenya ditulis dalam sebuah modul dan dijalankan dengan menekan sebuah
> > tombol
> >
> > Option Explicit
> > ' ======================================
> > ' coded by: Aji Mumpung
> > ' terinspirasi dari formula master Kid
> > ' kaki gunung merbabu, 17 Oktober 2012
> > ' sambil angon kambing & nyari rumput
> > ' ======================================
> > Sub AnalisaRAB()
> > Dim hdIdAhsDtl, hdIdAhsRab As Range
> > Dim idxRowDtl, idxRowAHS As Long
> > Dim r, RecNo, Htg As Long
> >
> > Application.ScreenUpdating = False
> > Set hdIdAhsDtl = Sheet2.Range("b9")
> > If Sheet2.Range("b9").Value = "" Then
> > MsgBox "Data detail ARB tidak ditemukan", vbOKOnly, "Pesan"
> > Exit Sub
> > End If
> > Set hdIdAhsRab = Sheet1.Range("c6")
> > idxRowAHS = Sheet1.Cells.SpecialCells(xlCellTypeLastCell).Row
> > idxRowDtl = Sheet2.Cells.SpecialCells(xlCellTypeLastCell).Row
> > For r = 9 To idxRowDtl
> > Sheet2.Select
> > If Cells(r, 2) = "" Then
> > Cells(r, 11).Value = Cells(r - 1, 11).Value
> > Else
> > Cells(r, 11).Value = Cells(r - 1, 11).Value + 1
> > End If
> > If Cells(r - 1, 11).Value = Cells(r, 11).Value Then
> > Cells(r, 12).Value = Cells(r - 1, 12).Value
> > Else
> > Cells(r, 12).Value =
> > Application.WorksheetFunction.Index(Range(Sheet1.Cells(6, 5),
> > Sheet1.Cells(idxRowAHS, 5)), _
> > Application.WorksheetFunction.Match(Sheet2.Cells(r, 2),
> > Range(Sheet1.Cells(6, 3), Sheet1.Cells(idxRowAHS, 3)), 0))
> > End If
> > If Cells(r, 12).Value <> 0 Then
> > Range(Cells(r, 2), Cells(r, 10)).Copy
> > Sheet3.Select
> > Range("c8").Select
> > If ActiveCell.Offset(1, 0) = "" Then
> > ActiveCell.Offset(1, -1).Select
> > Else
> > ActiveCell.End(xlDown).Offset(1, -1).Select
> > End If
> > ActiveCell.PasteSpecial (xlPasteValuesAndNumberFormats)
> > Application.CutCopyMode = False
> > End If
> > Next r
> > Sheet2.Select
> > Range("k:l").Delete
> > Application.ScreenUpdating = True
> > End Sub
> >
> >
> > wassalam,
> >
> > -aji mumpung-
> > #lagi angon sambil cari rumput#
> >
> > Pada 16 Oktober 2012 19:11, luthfi amin luthfie_27@... menulis:
> >
> > > **
>
> > >
> > >
> > > waduh maaf master kid,filenya kegedean gak lihat,maklum baru jadi
> > > anggota..
> > >
> > > dengan solusi sumproduct sudah sangat membantu,tapi analisa saya banyak
> > > master ada sekitar 650 analisa..
> > >
> > > ada tidak formula atau macro yang lebih efektif??
> > >
> > > trimakasih
> > >
> > >
> > >
> >
>
>  
>
Kid
Reply | Threaded
Open this post in threaded view
|  
Report Content as Inappropriate

Re: [belajar-excel] Re: solusi dengan filter, formula atau macro

Kid
Administrator
In reply to this post by LA27
Hai Luthfie,

Bagian yang merah adalah penggunaan fungsi Index dan Match dalam VBA.
Jika penggunaan sebuah fungsi melalui worksheetfunction dalam VBA menghasilkan
error value, maka akan muncul pesan error.
Coba sebelum baris yang di-merah tersebut diberi :
On Error Resume Next

Nanti akan tampak hasilnya tidak sesuai harapan karena ada data yang
error alias
hasil formulanya error.
Kemudian, perbaiki area data dalam sheet yang dirujuk oleh baris yang
dimerah.

Wassalam,
Kid.

2012/10/18 luthfie_27 <[hidden email]>

> Cells(r, 12).Value =
> > Application.WorksheetFunction.Index(Range(Sheet1.Cells(6, 5),
> > Sheet1.Cells(idxRowAHS, 5)), _
> > Application.WorksheetFunction.Match(Sheet2.Cells(r, 2),
> > Range(Sheet1.Cells(6, 3), Sheet1.Cells(idxRowAHS, 3)), 0))
Loading...