Menyederhanakan VBA

  1. 8 bulan yang lalu

    Bagaimana cara menyederhanakan array D1 - D20? karena kemungkinan saya memakai array lebih dari 20 nantinya? Thx.

    Sub CallDataPP()

    Application.ScreenUpdating = False

    Sheets("Final Result").Activate
    Range("B3:O3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.ClearContents

    D1 = Sheets("Check Item").Range("B2").Value
    D2 = Sheets("Check Item").Range("B3").Value
    D3 = Sheets("Check Item").Range("B4").Value
    D4 = Sheets("Check Item").Range("B5").Value
    D5 = Sheets("Check Item").Range("B6").Value
    D6 = Sheets("Check Item").Range("B7").Value
    D7 = Sheets("Check Item").Range("B8").Value
    D8 = Sheets("Check Item").Range("B9").Value
    D9 = Sheets("Check Item").Range("B10").Value
    D10 = Sheets("Check Item").Range("B11").Value
    D11 = Sheets("Check Item").Range("B12").Value
    D12 = Sheets("Check Item").Range("B13").Value
    D13 = Sheets("Check Item").Range("B14").Value
    D14 = Sheets("Check Item").Range("B15").Value
    D15 = Sheets("Check Item").Range("B16").Value
    D16 = Sheets("Check Item").Range("B17").Value
    D17 = Sheets("Check Item").Range("B18").Value
    D18 = Sheets("Check Item").Range("B19").Value
    D19 = Sheets("Check Item").Range("B20").Value
    D20 = Sheets("Check Item").Range("B21").Value

    Sheets("DB").Activate
    ActiveSheet.Range("$A:$P").AutoFilter Field:=1, Criteria1:=Array(D1, D2, D3, D4, D5, D6, D7, D8, D9, D10, D11, D12, D13, D14, D15, D16, D17, D18, D19, D20), Operator:=xlFilterValues
    Range("B3:L3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy

    Sheets("Final Result").Activate
    Range("B3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

    Sheets("DB").Activate
    ActiveSheet.Range("$A:$P").AutoFilter Field:=1
    Sheets("Final Result").Activate

    Application.ScreenUpdating = True


    End Sub

    Halo mas @dinatamk ..

    Untuk baris perintah di bawah ini :

    ...
    D1 = Sheets("Check Item").Range("B2").Value
    D2 = Sheets("Check Item").Range("B3").Value
    D3 = Sheets("Check Item").Range("B4").Value
    D4 = Sheets("Check Item").Range("B5").Value
    D5 = Sheets("Check Item").Range("B6").Value
    D6 = Sheets("Check Item").Range("B7").Value
    D7 = Sheets("Check Item").Range("B8").Value
    D8 = Sheets("Check Item").Range("B9").Value
    D9 = Sheets("Check Item").Range("B10").Value
    D10 = Sheets("Check Item").Range("B11").Value
    D11 = Sheets("Check Item").Range("B12").Value
    D12 = Sheets("Check Item").Range("B13").Value
    D13 = Sheets("Check Item").Range("B14").Value
    D14 = Sheets("Check Item").Range("B15").Value
    D15 = Sheets("Check Item").Range("B16").Value
    D16 = Sheets("Check Item").Range("B17").Value
    D17 = Sheets("Check Item").Range("B18").Value
    D18 = Sheets("Check Item").Range("B19").Value
    D19 = Sheets("Check Item").Range("B20").Value
    D20 = Sheets("Check Item").Range("B21").Value
    
    Sheets("DB").Activate
    ActiveSheet.Range("$A:$P").AutoFilter Field:=1, Criteria1:=Array(D1, D2, D3, D4, D5, D6, D7, D8, D9, D10, D11, D12, D13, D14, D15, D16, D17, D18, D19, D20), Operator:=xlFilterValues
    ...

    coba disederhanakan menjadi seperti berikut :

    lRow = Sheets("Check Item").Range("B2:B21").Rows.Count
    Redim xArray(lRow - 1)
    For lRow = 2 To 21
        xArray(lRow - 2) = Sheets("Check Item").Range("B" & lRow).Value
    Next
    
    Sheets("DB").Activate
    ActiveSheet.Range("$A:$P").AutoFilter Field:=1, Criteria1:=xArray, Operator:=xlFilterValues
    ...

    Demikian, semoga sesuai.

  2. Coba menggunakan Dynamic Name manager untuk Arraynya..

  3. Caton

    30 Mar 2021 Terverifikasi Jawaban Terpilih Indonesia + 17.741 Poin
    Di sunting 8 bulan yang lalu oleh Caton

    Halo mas @dinatamk ..

    Untuk baris perintah di bawah ini :

    ...
    D1 = Sheets("Check Item").Range("B2").Value
    D2 = Sheets("Check Item").Range("B3").Value
    D3 = Sheets("Check Item").Range("B4").Value
    D4 = Sheets("Check Item").Range("B5").Value
    D5 = Sheets("Check Item").Range("B6").Value
    D6 = Sheets("Check Item").Range("B7").Value
    D7 = Sheets("Check Item").Range("B8").Value
    D8 = Sheets("Check Item").Range("B9").Value
    D9 = Sheets("Check Item").Range("B10").Value
    D10 = Sheets("Check Item").Range("B11").Value
    D11 = Sheets("Check Item").Range("B12").Value
    D12 = Sheets("Check Item").Range("B13").Value
    D13 = Sheets("Check Item").Range("B14").Value
    D14 = Sheets("Check Item").Range("B15").Value
    D15 = Sheets("Check Item").Range("B16").Value
    D16 = Sheets("Check Item").Range("B17").Value
    D17 = Sheets("Check Item").Range("B18").Value
    D18 = Sheets("Check Item").Range("B19").Value
    D19 = Sheets("Check Item").Range("B20").Value
    D20 = Sheets("Check Item").Range("B21").Value
    
    Sheets("DB").Activate
    ActiveSheet.Range("$A:$P").AutoFilter Field:=1, Criteria1:=Array(D1, D2, D3, D4, D5, D6, D7, D8, D9, D10, D11, D12, D13, D14, D15, D16, D17, D18, D19, D20), Operator:=xlFilterValues
    ...

    coba disederhanakan menjadi seperti berikut :

    lRow = Sheets("Check Item").Range("B2:B21").Rows.Count
    Redim xArray(lRow - 1)
    For lRow = 2 To 21
        xArray(lRow - 2) = Sheets("Check Item").Range("B" & lRow).Value
    Next
    
    Sheets("DB").Activate
    ActiveSheet.Range("$A:$P").AutoFilter Field:=1, Criteria1:=xArray, Operator:=xlFilterValues
    ...

    Demikian, semoga sesuai.

  4. Terima kasih atas bantuannya mas @Caton , its work.

 

atau Mendaftar untuk ikut berdiskusi!