Bagaimana Cara Menyingkat Prosedur/Perintah yg berulang dan panjang?

  1. 2 tahun lalu

    Selamat siang rekan-rekan,
    Saat ini saya sedang membuat sistem input untuk kantor menggunakan macro-vba, tetapi terkendala prosedur yg dibuat terlalu panjang sehingga membatasi jumlah inputan.
    Mohon saran bagaimana cara untuk menyingkat prosedur/perintah berulah pada macro yg saya buat di bawah ini:
    Total Combobox ada 160, Textbox 80

    If ComboBox1 <> "Kode1" Then
            ActiveCell.FormulaR1C1 = CboBln.Value & "/" & CboTgl.Value & "/" & CboThn.Value
            ActiveCell.Offset(0, 1).Select
            ActiveCell.FormulaR1C1 = TxtPO.Value
            ActiveCell.Offset(0, 1).Select
            ActiveCell.FormulaR1C1 = CboToko.Value
            ActiveCell.Offset(0, 1).Select
            ActiveCell.FormulaR1C1 = ComboBox1.Value
            ActiveCell.Offset(0, 1).Select
            ActiveCell.FormulaR1C1 = ComboBox2.Value
            ActiveCell.Offset(0, 1).Select
            ActiveCell.FormulaR1C1 = TextBox1.Value
            ActiveCell.Offset(1, -4).Select
        End If
        
        If ComboBox3 <> "Kode2" Then
            ActiveCell.FormulaR1C1 = CboBln.Value & "/" & CboTgl.Value & "/" & CboThn.Value
            ActiveCell.Offset(0, 1).Select
            ActiveCell.FormulaR1C1 = TxtPO.Value
            ActiveCell.Offset(0, 1).Select
            ActiveCell.FormulaR1C1 = CboToko.Value
            ActiveCell.Offset(0, 1).Select
            ActiveCell.FormulaR1C1 = ComboBox3.Value
            ActiveCell.Offset(0, 1).Select
            ActiveCell.FormulaR1C1 = ComboBox4.Value
            ActiveCell.Offset(0, 1).Select
            ActiveCell.FormulaR1C1 = TextBox2.Value
            ActiveCell.Offset(1, -4).Select
        End If
        
        If ComboBox5 <> "Kode3" Then
            ActiveCell.FormulaR1C1 = CboBln.Value & "/" & CboTgl.Value & "/" & CboThn.Value
            ActiveCell.Offset(0, 1).Select
            ActiveCell.FormulaR1C1 = TxtPO.Value
            ActiveCell.Offset(0, 1).Select
            ActiveCell.FormulaR1C1 = CboToko.Value
            ActiveCell.Offset(0, 1).Select
            ActiveCell.FormulaR1C1 = ComboBox5.Value
            ActiveCell.Offset(0, 1).Select
            ActiveCell.FormulaR1C1 = ComboBox6.Value
            ActiveCell.Offset(0, 1).Select
            ActiveCell.FormulaR1C1 = TextBox3.Value
            ActiveCell.Offset(1, -4).Select
        End If
        
        If ComboBox7 <> "Kode4" Then
            ActiveCell.FormulaR1C1 = CboBln.Value & "/" & CboTgl.Value & "/" & CboThn.Value
            ActiveCell.Offset(0, 1).Select
            ActiveCell.FormulaR1C1 = TxtPO.Value
            ActiveCell.Offset(0, 1).Select
            ActiveCell.FormulaR1C1 = CboToko.Value
            ActiveCell.Offset(0, 1).Select
            ActiveCell.FormulaR1C1 = ComboBox7.Value
            ActiveCell.Offset(0, 1).Select
            ActiveCell.FormulaR1C1 = ComboBox8.Value
            ActiveCell.Offset(0, 1).Select
            ActiveCell.FormulaR1C1 = TextBox4.Value
            ActiveCell.Offset(1, -4).Select
        End If
        
        If ComboBox9 <> "Kode5" Then
            ActiveCell.FormulaR1C1 = CboBln.Value & "/" & CboTgl.Value & "/" & CboThn.Value
            ActiveCell.Offset(0, 1).Select
            ActiveCell.FormulaR1C1 = TxtPO.Value
            ActiveCell.Offset(0, 1).Select
            ActiveCell.FormulaR1C1 = CboToko.Value
            ActiveCell.Offset(0, 1).Select
            ActiveCell.FormulaR1C1 = ComboBox9.Value
            ActiveCell.Offset(0, 1).Select
            ActiveCell.FormulaR1C1 = ComboBox10.Value
            ActiveCell.Offset(0, 1).Select
            ActiveCell.FormulaR1C1 = TextBox5.Value
            ActiveCell.Offset(1, -4).Select
        End If
        
        If ComboBox11 <> "Kode6" Then
            ActiveCell.FormulaR1C1 = CboBln.Value & "/" & CboTgl.Value & "/" & CboThn.Value
            ActiveCell.Offset(0, 1).Select
            ActiveCell.FormulaR1C1 = TxtPO.Value
            ActiveCell.Offset(0, 1).Select
            ActiveCell.FormulaR1C1 = CboToko.Value
            ActiveCell.Offset(0, 1).Select
            ActiveCell.FormulaR1C1 = ComboBox11.Value
            ActiveCell.Offset(0, 1).Select
            ActiveCell.FormulaR1C1 = ComboBox12.Value
            ActiveCell.Offset(0, 1).Select
            ActiveCell.FormulaR1C1 = TextBox6.Value
            ActiveCell.Offset(1, -4).Select
        End If
        
        If ComboBox13 <> "Kode7" Then
            ActiveCell.FormulaR1C1 = CboBln.Value & "/" & CboTgl.Value & "/" & CboThn.Value
            ActiveCell.Offset(0, 1).Select
            ActiveCell.FormulaR1C1 = TxtPO.Value
            ActiveCell.Offset(0, 1).Select
            ActiveCell.FormulaR1C1 = CboToko.Value
            ActiveCell.Offset(0, 1).Select
            ActiveCell.FormulaR1C1 = ComboBox13.Value
            ActiveCell.Offset(0, 1).Select
            ActiveCell.FormulaR1C1 = ComboBox14.Value
            ActiveCell.Offset(0, 1).Select
            ActiveCell.FormulaR1C1 = TextBox7.Value
            ActiveCell.Offset(1, -4).Select
        End If

    Terima kasih atas bantuannya

  2. tghfox

    3 Sep 2016 Terverifikasi Bekasi Barat + 436 Poin

    gunakan perulangan for ... next

  3. @tghfox gunakan perulangan for ... next

    Boleh dkasih contoh riilnya bro, dr perintah di atas?

  4. tghfox

    3 Sep 2016 Terverifikasi Bekasi Barat + 436 Poin

    kalo ada file contoh nya bisa dilampirkan, tpi senin y, mau pulng ini bos

  5. Filenya terlampir ya bro.
    Mohon dibantu hehe
    Terima kasih banyak

  6. Hiks... Sepi

  7. tghfox

    17 Sep 2016 Terverifikasi Bekasi Barat + 436 Poin
    Di sunting 2 tahun lalu oleh tghfox

    maaf baru baca, lupa kalo sudah janji, hehehe

    bikin tombol baru ketikan kode berikut
    (untuk yang kombo interactivechange silahkan dikembangkan dari tombol simpan)
    search cara buat procedure dan parameter
    kode di bawah ini berdasarkan cara penamaan dan susunan control di form, jika berbeda
    harus disesuaikan tapi konsepnya sama

    Private Sub CommandButton1_Click()
    Dim lCombo As Long
    Dim lUrut  As Long, lBrsBaru As Long
    
    lCombo = 47
    
        For i = 1 To  lCombo 
            If i Mod 2 <> 0 Then
            lUrut = lUrut + 1
                If Me.Controls("ComboBox" & i).Value <> "Kode" & lUrut Then
                lBrsBaru = Sheets("Order").Range("A" & Rows.Count).End(xlUp).Row + 1
                Range("A" & lBrsBaru).Value = CboBln.Value & "/" & CboTgl.Value & "/" & CboThn.Value
                Range("B" & lBrsBaru).Value = TxtPO.Value
                Range("C" & lBrsBaru).Value = CboToko.Value
                Range("D" & lBrsBaru).Value = Me.Controls("ComboBox" & i).Value
                Range("E" & lBrsBaru).Value = Me.Controls("ComboBox" & i + 1).Value
                Range("F" & lBrsBaru).Value = Me.Controls("TextBox" & lUrut).Value
                
                End If
            End If
        Next i
        
    MsgBox "Simpan berhasil"
    
    End Sub

  8. Keren

 

atau Mendaftar untuk ikut berdiskusi!