Materi Perkuliahan

Membuat data lebih lanjut menggunakan VBA Excel

Dipublikasikan pada : 29 Januari 2020.

Private Sub CommandButton1_Click()
On Error Resume Next
Dim lembar As Worksheet
Dim martin As Range
Set lembar = Worksheets(2)
Set martin = lembar.Range(“C:C”).Find(Range(“B4”))
If Not martin Is Nothing Then
alamat = martin.Row
MsgBox “Data Sudah Ada”
Range(“B3”) = lembar.Range(“B” & alamat)
Range(“B4”) = lembar.Range(“C” & alamat)
Range(“B5”) = lembar.Range(“D” & alamat)
Range(“B6”) = lembar.Range(“E” & alamat)
Range(“B7”) = lembar.Range(“F” & alamat)
Range(“B8”) = lembar.Range(“T” & alamat)
Range(“B9”) = lembar.Range(“U” & alamat)
Range(“B10”) = lembar.Range(“V” & alamat)
Range(“B11”) = lembar.Range(“W” & alamat)
Range(“B12”) = lembar.Range(“X” & alamat)
Else
terakhir = lembar.Cells(lembar.Rows.Count, “A”).End(xlUp).Row
lembar.Range(“A” & terakhir + 1) = terakhir – 2
lembar.Range(“B” & terakhir + 1) = Range(“B3”)
lembar.Range(“C” & terakhir + 1) = Range(“B4”)
lembar.Range(“D” & terakhir + 1) = Range(“B5”)
lembar.Range(“E” & terakhir + 1) = Range(“B6”)
lembar.Range(“F” & terakhir + 1) = Range(“B7”)
lembar.Range(“T” & terakhir + 1) = Range(“B8”)
lembar.Range(“U” & terakhir + 1) = Range(“B9”)
lembar.Range(“V” & terakhir + 1) = Range(“B10”)
lembar.Range(“W” & terakhir + 1) = Range(“B11”)
lembar.Range(“X” & terakhir + 1) = Range(“B12”)
terakhir1 = lembar.Cells(lembar.Rows.Count, “A”).End(xlUp).Row
terakhir2 = lembar.Cells(lembar.Rows.Count, “B”).End(xlUp).Row
terakhir3 = lembar.Cells(lembar.Rows.Count, “C”).End(xlUp).Row
terakhir4 = lembar.Cells(lembar.Rows.Count, “D”).End(xlUp).Row
terakhir5 = lembar.Cells(lembar.Rows.Count, “E”).End(xlUp).Row
terakhir6 = lembar.Cells(lembar.Rows.Count, “F”).End(xlUp).Row
terakhir7 = lembar.Cells(lembar.Rows.Count, “T”).End(xlUp).Row
terakhir8 = lembar.Cells(lembar.Rows.Count, “U”).End(xlUp).Row
terakhir9 = lembar.Cells(lembar.Rows.Count, “V”).End(xlUp).Row
terakhir10 = lembar.Cells(lembar.Rows.Count, “W”).End(xlUp).Row
terakhir11 = lembar.Cells(lembar.Rows.Count, “X”).End(xlUp).Row
Range(“c3”) = terakhir2 – 3
Range(“c4”) = terakhir3 – 3
Range(“c5”) = terakhir4 – 3
Range(“c6”) = terakhir5 – 3
Range(“c7”) = terakhir6 – 3
Range(“c8”) = terakhir7 – 3
Range(“c9”) = terakhir8 – 3
Range(“c10”) = terakhir9 – 3
Range(“c11”) = terakhir10 – 3
Range(“c12”) = terakhir11 – 3
Range(“B1”) = terakhir1 – 3
Range(“B3:B12”) = “”
End If
End Sub

Private Sub CommandButton10_Click()
Dim lembar As Worksheet
Dim lembaran As Worksheet
Dim a As Integer
Range(“B18:B21”) = “”
Range(“B23:B54”) = “”
Set lembar = Worksheets(5)
akhir = lembar.Cells(lembar.Rows.Count, “A”).End(xlUp).Row
For a = 1 To 5
c = 0
For b = 1 To akhir
If lembar.Range(“D” & b) = Range(“A” & 17 + a) Then
c = c + 1
Range(“B” & 17 + a) = c
End If
Next b
Next a
For d = 1 To 32
e = 0
For f = 1 To akhir
If lembar.Range(“E” & f) = Range(“A” & 23 + d) Then
e = e + 1
Range(“B” & 23 + d) = e
End If
Next f
Next d

End Sub

Private Sub CommandButton11_Click()
Dim lembar As Worksheet
Dim a As Integer
Range(“B18:B21”) = “”
Range(“B23:B54”) = “”
Set lembar = Worksheets(5)
akhir = lembar.Cells(lembar.Rows.Count, “A”).End(xlUp).Row
For a = 1 To 4
c = 0
For b = 1 To akhir
If lembar.Range(“F” & b) = Range(“A” & 17 + a) Then
c = c + 1
Range(“B” & 17 + a) = c
End If
Next b
Next a
For d = 1 To 32
e = 0
For f = 1 To akhir
If lembar.Range(“G” & f) = Range(“A” & 22 + d) Then
e = e + 1
Range(“B” & 22 + d) = e
End If
Next f
Next d
End Sub

Private Sub CommandButton12_Click()
Dim lembar As Worksheet
Dim alamat As Range
Dim akhir As Integer
Range(“C19:K100”) = “”
Set lembar = Worksheets(5)
Set alamat = lembar.Range(“D:D”).Find(Range(“D17”))
akhir = lembar.Cells(lembar.Rows.Count, “A”).End(xlUp).Row
Range(“C19:K100”).WrapText = True
j = 0
For i = 1 To akhir
If lembar.Range(“F” & i) = Range(“I17”) Then
j = j + 1
Range(“C” & 18 + j) = j
Range(“D” & 18 + j) = lembar.Range(“B” & i)
Range(“E” & 18 + j) = lembar.Range(“C” & i)
Range(“F” & 18 + j) = lembar.Range(“D” & i)
Range(“G” & 18 + j) = lembar.Range(“E” & i)
Range(“H” & 18 + j) = lembar.Range(“F” & i)
Range(“I” & 18 + j) = lembar.Range(“G” & i)
Range(“J” & 18 + j) = lembar.Range(“H” & i)
Range(“K” & 18 + j) = lembar.Range(“I” & i)
End If
Next i
End Sub

Private Sub CommandButton13_Click()
Dim lembar As Worksheet
Dim alamat As Range
Dim akhir As Integer
Range(“C19:K100”) = “”
Set lembar = Worksheets(5)
Set alamat = lembar.Range(“D:D”).Find(Range(“D17”))
akhir = lembar.Cells(lembar.Rows.Count, “A”).End(xlUp).Row
Range(“C19:K100”).WrapText = True
j = 0
For i = 1 To akhir
If lembar.Range(“G” & i) = Range(“H17”) Then
j = j + 1
Range(“C” & 18 + j) = j
Range(“D” & 18 + j) = lembar.Range(“B” & i)
Range(“E” & 18 + j) = lembar.Range(“C” & i)
Range(“F” & 18 + j) = lembar.Range(“D” & i)
Range(“G” & 18 + j) = lembar.Range(“E” & i)
Range(“H” & 18 + j) = lembar.Range(“F” & i)
Range(“I” & 18 + j) = lembar.Range(“G” & i)
Range(“J” & 18 + j) = lembar.Range(“H” & i)
Range(“K” & 18 + j) = lembar.Range(“I” & i)
End If
Next i
End Sub

Private Sub CommandButton2_Click()
Dim lembar As Worksheet
Dim lembar1 As Worksheet
Dim martin As Range
Dim martin1 As Range
Set lembar = Worksheets(2)
Set lembar1 = Worksheets(4)
Set martin = lembar.Range(“C:C”).Find(Range(“F3”))
Set martin1 = lembar1.Range(“B:B”).Find(Range(“F3”))
alamat = martin.Row
alamat1 = martin1.Row
If Not martin Is Nothing Then
Range(“B3”) = lembar.Range(“B” & alamat)
Range(“B4”) = lembar.Range(“C” & alamat)
Range(“B5”) = lembar.Range(“D” & alamat)
Range(“B6”) = lembar.Range(“E” & alamat)
Range(“B7”) = lembar.Range(“F” & alamat)
Range(“B8”) = lembar.Range(“T” & alamat)
Range(“B9”) = lembar.Range(“U” & alamat)
Range(“B10”) = lembar.Range(“V” & alamat)
Range(“B11”) = lembar.Range(“W” & alamat)
Range(“B12”) = lembar.Range(“X” & alamat)
Range(“D11”) = lembar1.Range(“E” & alamat1)
Range(“D12”) = lembar1.Range(“G” & alamat1)
Else
MsgBox “Tidak ditemukan data”
End If
End Sub

Private Sub CommandButton3_Click()
On Error Resume Next
Range(“B3:B12”) = “”
For i = 1 To 30
Shapes(“gambar” & i & “.jpg”).Delete
Next i
End Sub

Private Sub CommandButton4_Click()
Dim lembar As Worksheet
Dim lembar1 As Worksheet
Dim lembar2 As Worksheet
Dim lembar3 As Worksheet
Dim lembar4 As Worksheet
Set lembar = Worksheets(3)
Set lembar1 = Worksheets(2)
Set lembar2 = Worksheets(4)
Set lembar3 = Worksheets(5)
Set lembar4 = Worksheets(6)
terakhir1 = lembar1.Cells(lembar1.Rows.Count, “A”).End(xlUp).Row
For a = 4 To terakhir1
lembar.Range(“B” & a) = lembar1.Range(“C” & a)
lembar.Range(“C” & a) = lembar1.Range(“D” & a)
lembar.Range(“A” & a) = a – 3
lembar2.Range(“B” & a) = lembar1.Range(“C” & a)
lembar2.Range(“C” & a) = lembar1.Range(“D” & a)
lembar2.Range(“A” & a) = a – 3
lembar2.Range(“D” & a) = lembar1.Range(“W” & a)
lembar2.Range(“F” & a) = lembar1.Range(“X” & a)
lembar3.Range(“B” & a) = lembar1.Range(“C” & a)
lembar3.Range(“C” & a) = lembar1.Range(“D” & a)
lembar3.Range(“A” & a) = a – 3
lembar3.Range(“D” & a) = lembar1.Range(“W” & a)
lembar3.Range(“E” & a) = lembar1.Range(“X” & a)
lembar4.Range(“B” & a) = lembar1.Range(“C” & a)
lembar4.Range(“C” & a) = lembar1.Range(“D” & a)
lembar4.Range(“A” & a) = a – 3
Next a
terakhir = lembar.Cells(lembar.Rows.Count, “A”).End(xlUp).Row
terakhir2 = lembar2.Cells(lembar2.Rows.Count, “A”).End(xlUp).Row
terakhir3 = lembar3.Cells(lembar3.Rows.Count, “A”).End(xlUp).Row
terakhir4 = lembar4.Cells(lembar4.Rows.Count, “A”).End(xlUp).Row
Range(“G5”) = terakhir – 3
Range(“G6”) = terakhir2 – 3
Range(“G7”) = terakhir3 – 3
Range(“G8”) = terakhir4 – 3
End Sub

Private Sub CommandButton5_Click()
On Error Resume Next
For i = 1 To 30
Shapes(“gambar” & i & “.jpg”).Delete
Next i
Dim lembar As Worksheet
Dim lembar1 As Worksheet

Dim gambar As Shape
Set lembar = Worksheets(2)
Set lembar1 = Worksheets(4)

Range(“j5”) = Range(“j5”) + 1
j = Range(“j5”)
Range(“B3”) = lembar.Range(“B” & 3 + j)
Range(“B4”) = lembar.Range(“C” & 3 + j)
Range(“B5”) = lembar.Range(“D” & 3 + j)
Range(“B6”) = lembar.Range(“E” & 3 + j)
Range(“B7”) = lembar.Range(“F” & 3 + j)
Range(“B8”) = lembar.Range(“T” & 3 + j)
Range(“B9”) = lembar.Range(“U” & 3 + j)
Range(“B10”) = lembar.Range(“V” & 3 + j)
Range(“B11”) = lembar.Range(“W” & 3 + j)
Range(“B12”) = lembar.Range(“X” & 3 + j)
Set gambar = Shapes.AddPicture(“C:\Users\Prodi Math\Desktop\SIDANG 2017\Juli 2017\Sidang 19 Juli 2017\gambar” & j & “.jpg”, msoTrue, msoTrue, Range(“D3”).Left, Range(“D3”).Top, Range(“D3”).Width, 5 * Range(“D3”).Height)
Range(“D11”) = lembar1.Range(“E” & 3 + j)
Range(“D12”) = lembar1.Range(“G” & 3 + j)
End Sub

Private Sub CommandButton6_Click()
On Error Resume Next
For i = 1 To 30
Shapes(“gambar” & i & “.jpg”).Delete
Next i
Dim lembar As Worksheet
Dim lembar1 As Worksheet
Dim gambar As Shape
Set lembar = Worksheets(2)
Set lembar1 = Worksheets(4)
Range(“j5”) = Range(“j5”) – 1
j = Range(“j5”)
If Range(“J5”) < 1 Then
Range(“J5”) = 1
j = Range(“J5”)
End If
Set gambar = Shapes.AddPicture(“C:\Users\Prodi Math\Desktop\SIDANG 2017\Juli 2017\Sidang 19 Juli 2017\gambar” & j & “.jpg”, msoTrue, msoTrue, Range(“D3”).Left, Range(“D3”).Top, Range(“D3”).Width, 5 * Range(“D3”).Height)
Range(“B3”) = lembar.Range(“B” & 3 + j)
Range(“B4”) = lembar.Range(“C” & 3 + j)
Range(“B5”) = lembar.Range(“D” & 3 + j)
Range(“B6”) = lembar.Range(“E” & 3 + j)
Range(“B7”) = lembar.Range(“F” & 3 + j)
Range(“B8”) = lembar.Range(“T” & 3 + j)
Range(“B9”) = lembar.Range(“U” & 3 + j)
Range(“B10”) = lembar.Range(“V” & 3 + j)
Range(“B11”) = lembar.Range(“W” & 3 + j)
Range(“B12”) = lembar.Range(“X” & 3 + j)
Range(“D11”) = lembar1.Range(“E” & 3 + j)
Range(“D12”) = lembar1.Range(“G” & 3 + j)
End Sub

Private Sub CommandButton7_Click()
Dim lembar As Worksheet
Dim lembaran As Worksheet
Dim alamat As Range
Set lembar = Worksheets(4)
Set lembaran = Worksheets(5)
Set alamat = lembar.Range(“B:B”).Find(Range(“B4”))
nomor = alamat.Row
lembar.Range(“E” & nomor) = Range(“D11”)
lembar.Range(“G” & nomor) = Range(“D12”)
lembaran.Range(“H” & Range(“J5”) + 3) = Range(“E11”)
lembaran.Range(“I” & Range(“J5”) + 3) = Range(“F11”)
End Sub

Private Sub CommandButton8_Click()
Dim lembar As Worksheet
Dim alamat As Range
Dim akhir As Integer
Range(“C19:K100”) = “”
Set lembar = Worksheets(5)
Set alamat = lembar.Range(“D:D”).Find(Range(“D17”))
akhir = lembar.Cells(lembar.Rows.Count, “A”).End(xlUp).Row
Range(“C19:K100”).WrapText = True
j = 0
For i = 1 To akhir
If lembar.Range(“D” & i) = Range(“D17”) Then
j = j + 1
Range(“C” & 18 + j) = j
Range(“D” & 18 + j) = lembar.Range(“B” & i)
Range(“E” & 18 + j) = lembar.Range(“C” & i)
Range(“F” & 18 + j) = lembar.Range(“D” & i)
Range(“G” & 18 + j) = lembar.Range(“E” & i)
Range(“H” & 18 + j) = lembar.Range(“F” & i)
Range(“I” & 18 + j) = lembar.Range(“G” & i)
Range(“J” & 18 + j) = lembar.Range(“H” & i)
Range(“K” & 18 + j) = lembar.Range(“I” & i)
End If
Next i
End Sub

Private Sub CommandButton9_Click()
Dim lembar As Worksheet
Dim akhir As Integer
Range(“C19:K100”) = “”
Set lembar = Worksheets(5)
akhir = lembar.Cells(lembar.Rows.Count, “A”).End(xlUp).Row
Range(“C19:K100”).WrapText = True
j = 0
For i = 1 To akhir
If lembar.Range(“E” & i) = Range(“F17”) Then
j = j + 1
Range(“C” & 18 + j) = j
Range(“D” & 18 + j) = lembar.Range(“B” & i)
Range(“E” & 18 + j) = lembar.Range(“C” & i)
Range(“F” & 18 + j) = lembar.Range(“D” & i)
Range(“G” & 18 + j) = lembar.Range(“E” & i)
Range(“H” & 18 + j) = lembar.Range(“F” & i)
Range(“I” & 18 + j) = lembar.Range(“G” & i)
Range(“J” & 18 + j) = lembar.Range(“H” & i)
Range(“K” & 18 + j) = lembar.Range(“I” & i)
End If
Next i
End Sub

id_IDIndonesian