1. pencarian dengan menggunakan textbox1 dan di tampilkan di textbox lain
Private Sub TextBox1_Change()
Set Macro = Sheets("Sheet1")
On Error Resume Next
Set EditMacro = Macro.Range("A3Kebawah")
Set c = EditMacro.Find(TextBox1.Value, _
LookIn:=xlValues)
TextBox2.Value = c.Offset(0, 1).Value
TextBox3.Value = c.Offset(0, 2).Value
TextBox4.Value = c.Offset(0, 3).Value
End Sub
2. Pencarian bagian 2
Input data berdasarkan kolom pencarian 1
Dim Kode
Dim CellTujuan As Range
Kode = TextBox1.Value
Set CellTujuan = Range("C3:ZZ3").Find(What:=Kode,
LookIn:=xlValues, LookAt:=xlWhole)
If Not CellTujuan Is Nothing Then
TextBox2 = Cells(4, CellTujuan.Column)
End If
3. Pencarian bagian 3
Dim x As Range
For Each x In Range("A1:Z100")
If x.Value = CStr(TextBox1.Value) Then
TextBox2.Value = x.Offset(1, 0).Value
End If
Next
4. pencarian pada 3 sheet
Mencari data 3 sheet
Private Sub TextBox2_Change()
Dim i As integer
For i = 1 to 3
Set IpAoNE = Sheets("Sheet"&i)
Set IdRangeA = IpAoNE.Range("B3:B8")
Set c = IdRangeA.Find(TextBox1.Value,
LookIn:=xlValues)
TextBox2.Value = c.Offset(0, 1).Value
TextBox3.Value = c.Offset(0, 2).Value
Next i
End Sub
28.04.2017
*********(((
PENGEMBANGN
3 sheet
Bulanjanuari, bulanpebruari, Bulanmei
Dim i As integer
Dim 1, 2, 3
1 = Januari
2 = pebruari
3 = maret
For i = 1 to 3
Set IpAoNE = Sheets("bulan"&i)
Set IdRangeA = IpAoNE.Range("B3:B8")
Set c = IdRangeA.Find(TextBox2.Value,
LookIn:=xlValues, _
MatchCase:=False)
TextBox1.Value = c.Offset(0, -1).Value
TextBox3.Value = c.Offset(0, 1).Value
Next i
End Sub
SALAM HORMAT KEPADA PEMBACA Setiap bacaan tentang Kejadian, Perkataan, Perbuatan, dan Sikap orang lain, seringkali membekas dalam diri kita, baik sengaja atau pun tidak sengaja.
SALAM PEMBUKA
- ASSALAMU 'ALAIKUM WAROHMATULLAHI WABAROKATUH
Tampilkan postingan dengan label VBA EXCEL. Tampilkan semua postingan
Tampilkan postingan dengan label VBA EXCEL. Tampilkan semua postingan
Jumat, 21 April 2017
Jumat, 31 Maret 2017
Cara memasukkan isi listbox ke textbox beda userform
Untuk menampilkan userform3 dan mengisi textbox dari listbox yg di userform1
Di tulis dalam event doble clik listbox
Privat sub listCaridblclik
if listCari.listindex < 0 then exit sub
Userform3.Textbox1 = listCari. List (listCari. Listindex, 0)
Userform3.show
End sub
Jumat, 24 Maret 2017
Menghapus data terpilih dalam listbox
Private Sub CommandButton2_Click()
'perintah untuk menghapus data Terpilih dari dalam ListBox2
Dim counter As Integer
counter = 0
For i = 0 To ListBox2.ListCount - 1
If ListBox2.Selected(i - counter) Then
ListBox2.RemoveItem (i - counter)
counter = counter + 1
End If
Next i
End Sub
'perintah untuk menghapus data Terpilih dari dalam ListBox2
Dim counter As Integer
counter = 0
For i = 0 To ListBox2.ListCount - 1
If ListBox2.Selected(i - counter) Then
ListBox2.RemoveItem (i - counter)
counter = counter + 1
End If
Next i
End Sub
Jumat, 17 Maret 2017
cara menggunakan kode Penjumlahan pada listbox
cara menggunakan kode Penjumlahan pada listbox
Private Sub totalharga()
Dim i As Integer
Dim harga As Long
harga = 0
For i = 0 To ListBox1.ListCount - 1
harga = harga + Val(ListBox1.List(i, 2))
Next
Me.txtotal.Text = harga
End Sub
Penjumlahan list box2
Sub hitung ()
With listbox1
Me.TxtTotal=0
For i =1 to. ListCount - 1
Me.TxtTotal = csng (me.txtTotal) + csng (. List (i, 4))
Next
End with
End sub
Sub hitung ()
With listbox1
Me.TxtTotal=0
For i =1 to. ListCount - 1
Me.TxtTotal = csng (me.txtTotal) + csng (. List (i, 4))
Next
End with
End sub
Jumat, 10 Maret 2017
Cara Memberi Nama Header / Kepala Kolom
Cara Memberi Nama Header / Kepala Kolom
Sub Headerlist()
With ListBox1
.AddItem
.List(.ListCount - 1, 0) = "Nomor"
.List(.ListCount - 1, 1) = "Nama Siswa"
.List(.ListCount - 1, 2) = "Kelas"
.List(.ListCount - 1, 3) = "Wali murid"
.ColumnWidths = 35 & ";" & 70 & ";" & 45 & ";" & 80
End With
End Sub
Sub Headerlist()
With ListBox1
.AddItem
.List(.ListCount - 1, 0) = "Nomor"
.List(.ListCount - 1, 1) = "Nama Siswa"
.List(.ListCount - 1, 2) = "Kelas"
.List(.ListCount - 1, 3) = "Wali murid"
.ColumnWidths = 35 & ";" & 70 & ";" & 45 & ";" & 80
End With
End Sub
Jumat, 03 Maret 2017
Macam Macam fungsi Listview
macam macam fungsi listview
1. Menampilkan Data pada TextBox saat data diKlik pada
ListView
Private Sub ListView1_ItemClick(ByVal Item As
MSComctlLib.ListItem)
TextBox1 = ListView1.SelectedItem
TextBox2 = ListView1.SelectedItem.SubItems(1)
TextBox3 = ListView1.SelectedItem.SubItems(2)
TextBox4 = ListView1.SelectedItem.SubItems(3)
TextBox5 = ListView1.SelectedItem.SubItems(4)
End Sub
2. Memberikan Judul pada ListView
Private Sub UserForm_Initialize()
With ListView1
.Gridlines = True
.View = lvwReport
.FullRowSelect = True
.ColumnHeaders.Add Text:="Tanggal Transaksi", Width:=100
.ColumnHeaders.Add Text:="Nama Produk", Width:=170
.ColumnHeaders.Add Text:="Satuan", Width:=60
.ColumnHeaders.Add Text:="Jumlah", Width:=40
.ColumnHeaders.Add Text:="Total Harga", Width:=100
End With
Call Tampil
End Sub
3. Menampilkan data dari Worksheet Excell ke dalam
ListView
Sub Tampil()
Dim Item As ListItem
Dim rekamandata As Integer
Dim i As Integer
ListView1.ListItems.Clear
rekamandata = Sheet1.Cells(Rows.Count, 1).End
(xlUp).Row
For i = 4 To rekamandata
Set Item = ListView1.ListItems.Add(Text:=Sheet1.Cells(i,
1))
Item.SubItems(1) = Sheet1.Cells(i, 2)
Item.SubItems(2) = Sheet1.Cells(i, 3)
Item.SubItems(3) = Sheet1.Cells(i, 4)
Item.SubItems(4) = Sheet1.Cells(i, 5)
Next
Label1.Caption = ListView1.ListItems.Count 'Menghitung
Data Dalam ListView
End Sub
1. Menampilkan Data pada TextBox saat data diKlik pada
ListView
Private Sub ListView1_ItemClick(ByVal Item As
MSComctlLib.ListItem)
TextBox1 = ListView1.SelectedItem
TextBox2 = ListView1.SelectedItem.SubItems(1)
TextBox3 = ListView1.SelectedItem.SubItems(2)
TextBox4 = ListView1.SelectedItem.SubItems(3)
TextBox5 = ListView1.SelectedItem.SubItems(4)
End Sub
2. Memberikan Judul pada ListView
Private Sub UserForm_Initialize()
With ListView1
.Gridlines = True
.View = lvwReport
.FullRowSelect = True
.ColumnHeaders.Add Text:="Tanggal Transaksi", Width:=100
.ColumnHeaders.Add Text:="Nama Produk", Width:=170
.ColumnHeaders.Add Text:="Satuan", Width:=60
.ColumnHeaders.Add Text:="Jumlah", Width:=40
.ColumnHeaders.Add Text:="Total Harga", Width:=100
End With
Call Tampil
End Sub
3. Menampilkan data dari Worksheet Excell ke dalam
ListView
Sub Tampil()
Dim Item As ListItem
Dim rekamandata As Integer
Dim i As Integer
ListView1.ListItems.Clear
rekamandata = Sheet1.Cells(Rows.Count, 1).End
(xlUp).Row
For i = 4 To rekamandata
Set Item = ListView1.ListItems.Add(Text:=Sheet1.Cells(i,
1))
Item.SubItems(1) = Sheet1.Cells(i, 2)
Item.SubItems(2) = Sheet1.Cells(i, 3)
Item.SubItems(3) = Sheet1.Cells(i, 4)
Item.SubItems(4) = Sheet1.Cells(i, 5)
Next
Label1.Caption = ListView1.ListItems.Count 'Menghitung
Data Dalam ListView
End Sub
Jumat, 24 Februari 2017
CARA memasukkan data TextBox Ke dalam ListBox
memasukkan data TextBox Ke dalam ListBox
Private Sub CommandButton1_Click()
With ListBox1
.AddItem
.List(.ListCount - 1, 0) = TextBox1.Value
.List(.ListCount - 1, 1) = TextBox2.Value
.List(.ListCount - 1, 2) = TextBox3.Value
.List(.ListCount - 1, 3) = TextBox4.Value
End With
End Sub
Jumat, 17 Februari 2017
Cara memasukan isi List Box ke Textbox pada Vba excel.
ini merupakan kode Cara memasukan isi List Box ke Textbox
pada Vba excel.
Private Sub listBox1_Click()
TextBox1.Value = Listbox1.List(listBox1.ListIndex, 1)
TextBox2.Value = Listbox1.List(listBox1.ListIndex, 2)
TextBox3.Value = Listbox1.List(listBox1.ListIndex, 3)
End Sub
Private Sub listBox1_Click()
'masukan teks dalam listbox kolom pertama ke dalam
texbox1
TextBox1.Value = Listbox1.List(listBox1.ListIndex, 1)
'masukan teks dalam listbox kolom kedua ke dalam
texbox2
TextBox2.Value = Listbox1.List(listBox1.ListIndex, 2)
'masukan teks dalam listbox kolom ketiga ke dalam
texbox3
TextBox3.Value = Listbox1.List(listBox1.ListIndex, 3)
End Sub
pada Vba excel.
Private Sub listBox1_Click()
TextBox1.Value = Listbox1.List(listBox1.ListIndex, 1)
TextBox2.Value = Listbox1.List(listBox1.ListIndex, 2)
TextBox3.Value = Listbox1.List(listBox1.ListIndex, 3)
End Sub
Private Sub listBox1_Click()
'masukan teks dalam listbox kolom pertama ke dalam
texbox1
TextBox1.Value = Listbox1.List(listBox1.ListIndex, 1)
'masukan teks dalam listbox kolom kedua ke dalam
texbox2
TextBox2.Value = Listbox1.List(listBox1.ListIndex, 2)
'masukan teks dalam listbox kolom ketiga ke dalam
texbox3
TextBox3.Value = Listbox1.List(listBox1.ListIndex, 3)
End Sub
Jumat, 10 Februari 2017
Menampilkan Data Worksheet Ke dalam ListBox
Menampilkan Data Worksheet Ke dalam ListBox
Sub TampilkanSemua()
Set wsDtbsPlgn = Sheets("Data")
ListBox1.Clear
ListBox1.ColumnCount = 6
ListBox1.ColumnWidths = 80 & ";" & 25 & ";" &
35 & ";" & 65 & ";" & 120
Set rgTampil = wsDtbsPlgn.Range
("A1:A100").SpecialCells(xlCellTypeVisible)
For Each i In rgTampil
With ListBox1
.AddItem
.List(.ListCount - 1, 0) = i.Value
.List(.ListCount - 1, 1) = i.Offset(0, 1).Value
.List(.ListCount - 1, 2) = i.Offset(0, 2).Value
.List(.ListCount - 1, 3) = i.Offset(0, 3).Value
.List(.ListCount - 1, 4) = i.Offset(0, 4).Value
End With
Next i
End Sub
Jumat, 03 Februari 2017
MACAM MACAM INPUT DATA VBA EXCEL
MACAM MACAM INPUT DATA VBA EXCEL
1. Input data hanya 1 sheet
Dim iRow As Long
Dim ws As Worksheet
Set ws = Worksheets(“Barang”)
‘menemukan baris kosong pada database
iRow = ws.Cells(Rows.Count, 1) _
.End(xlUp).Offset(1, 0).Row
‘check untuk sebuah kode
If Trim(TextBox1.Value) = “” Then
TextBox1.SetFocus
MsgBox “Masukan Kode Barang”
Exit Sub
End If
‘copy data ke database
ws.Cells(iRow, 1).Value = TextBox1.Value
ws.Cells(iRow, 2).Value = TextBox2.Value
ws.Cells(iRow, 3).Value = TextBox3.Value
ws.Cells(iRow, 4).Value = TextBox4.Value
‘clear data
TextBox1.Value = “”
TextBox2.Value = “”
TextBox3.Value = “”
TextBox4.Value = “”
TextBox1.SetFocus
END SUB
2. input data berayarat manual sesuai nama sheet
yaitu tambahkan kode pada tombo pesan
Private Sub CommandButton1_Click()
Set ws = Worksheets("BUAH")
Set ws2 = Worksheets("KUE")
Set ws3 = Worksheets("PERMEN")
Set ws4 = Worksheets("NASI")
'menemukan baris kosong pada database
iRow = ws.Cells(Rows.Count, 1) _
.End(xlUp).Offset(1, 0).Row
iRow2 = ws2.Cells(Rows.Count, 1) _
.End(xlUp).Offset(1, 0).Row
iRow3 = ws3.Cells(Rows.Count, 1) _
.End(xlUp).Offset(1, 0).Row
iRow4 = ws4.Cells(Rows.Count, 1) _
.End(xlUp).Offset(1, 0).Row
'check untuk sebuah kode
If Trim(Me.TextBox1.Value) = "" Then
Me.TextBox1.SetFocus
MsgBox "Masukan Kode Pembeli"
Exit Sub
End If
'copy data ke database
If ComboBox1.Value = "BUAH" Then
With ws
ws.Cells(iRow, 1).Value = Me.TextBox1.Value
ws.Cells(iRow, 2).Value = Me.TextBox2.Value
End With
ElseIf ComboBox1.Value = "KUE" Then
With ws2
ws2.Cells(iRow2, 1).Value = Me.TextBox1.Value
ws2.Cells(iRow2, 2).Value = Me.TextBox2.Value
End With
ElseIf ComboBox1.Value = "PERMEN" Then
With ws3
ws3.Cells(iRow3, 1).Value = Me.TextBox1.Value
ws3.Cells(iRow3, 2).Value = Me.TextBox2.Value
End With
ElseIf ComboBox1.Value = "NASI" Then
With ws
ws4.Cells(iRow4, 1).Value = Me.TextBox1.Value
ws4.Cells(iRow4, 2).Value = Me.TextBox2.Value
End With
End If
'clear data
Me.TextBox1.Value = ""
Me.TextBox2.Value = ""
Me.TextBox1.SetFocus
MsgBox "DATA TELAH DI SIMPAN"
End Sub
3.A. Input data berdasarkan kolom pencarian 1
Dim Kode
Dim CellTujuan As Range
Kode = TextBox1.Value
Set CellTujuan = Range("C3:ZZ3").Find(What:=Kode,
LookIn:=xlValues, LookAt:=xlWhole)
If Not CellTujuan Is Nothing Then
TextBox2 = Cells(4, CellTujuan.Column)
End If
iRow = ws.Cells(Rows.Count, CellTujuan.Column) _
.End(xlUp).Offset(1, CellTujuan.Column).Row
ws.Cells(iRow, CellTujuan.Column).Value = Textbox2.Value
3.B.Input data berdasarkan kolom pencarian 2
Dim x As Range
For Each x In Range("A1:Z100")
If x.Value = CStr(TextBox1.Value) Then
TextBox2.Value = x.Offset(1, 0).Value
End If
Next
iRow = ws.Cells(Rows.Count, x.Column) _
.End(xlUp).Offset(1, x.Column).Row
ws.Cells(iRow, x.Column).Value = Textbox2.Value
4. Input data KEDALAM SHEET, NAMA SHEET SESUAI TEXTBOX
Dim iRow As Long
Dim ws As Worksheet
nama = TextBulan.value
Set ws = Worksheets(nama)
‘menemukan baris kosong pada database
iRow = ws.Cells(Rows.Count, 1) _
.End(xlUp).Offset(1, 0).Row
‘check untuk sebuah kode
If Trim(TextBox1.Value) = “” Then
TextBox1.SetFocus
MsgBox “Masukan Kode Barang”
Exit Sub
End If
‘copy data ke database
ws.Cells(iRow, 1).Value = TextBox1.Value
ws.Cells(iRow, 2).Value = TextBox2.Value
ws.Cells(iRow, 3).Value = TextBox3.Value
ws.Cells(iRow, 4).Value = TextBox4.Value
‘clear data
TextBox1.Value = “”
TextBox2.Value = “”
TextBox3.Value = “”
TextBox4.Value = “”
TextBox1.SetFocus
END SUB
1. Input data hanya 1 sheet
Dim iRow As Long
Dim ws As Worksheet
Set ws = Worksheets(“Barang”)
‘menemukan baris kosong pada database
iRow = ws.Cells(Rows.Count, 1) _
.End(xlUp).Offset(1, 0).Row
‘check untuk sebuah kode
If Trim(TextBox1.Value) = “” Then
TextBox1.SetFocus
MsgBox “Masukan Kode Barang”
Exit Sub
End If
‘copy data ke database
ws.Cells(iRow, 1).Value = TextBox1.Value
ws.Cells(iRow, 2).Value = TextBox2.Value
ws.Cells(iRow, 3).Value = TextBox3.Value
ws.Cells(iRow, 4).Value = TextBox4.Value
‘clear data
TextBox1.Value = “”
TextBox2.Value = “”
TextBox3.Value = “”
TextBox4.Value = “”
TextBox1.SetFocus
END SUB
2. input data berayarat manual sesuai nama sheet
yaitu tambahkan kode pada tombo pesan
Private Sub CommandButton1_Click()
Set ws = Worksheets("BUAH")
Set ws2 = Worksheets("KUE")
Set ws3 = Worksheets("PERMEN")
Set ws4 = Worksheets("NASI")
'menemukan baris kosong pada database
iRow = ws.Cells(Rows.Count, 1) _
.End(xlUp).Offset(1, 0).Row
iRow2 = ws2.Cells(Rows.Count, 1) _
.End(xlUp).Offset(1, 0).Row
iRow3 = ws3.Cells(Rows.Count, 1) _
.End(xlUp).Offset(1, 0).Row
iRow4 = ws4.Cells(Rows.Count, 1) _
.End(xlUp).Offset(1, 0).Row
'check untuk sebuah kode
If Trim(Me.TextBox1.Value) = "" Then
Me.TextBox1.SetFocus
MsgBox "Masukan Kode Pembeli"
Exit Sub
End If
'copy data ke database
If ComboBox1.Value = "BUAH" Then
With ws
ws.Cells(iRow, 1).Value = Me.TextBox1.Value
ws.Cells(iRow, 2).Value = Me.TextBox2.Value
End With
ElseIf ComboBox1.Value = "KUE" Then
With ws2
ws2.Cells(iRow2, 1).Value = Me.TextBox1.Value
ws2.Cells(iRow2, 2).Value = Me.TextBox2.Value
End With
ElseIf ComboBox1.Value = "PERMEN" Then
With ws3
ws3.Cells(iRow3, 1).Value = Me.TextBox1.Value
ws3.Cells(iRow3, 2).Value = Me.TextBox2.Value
End With
ElseIf ComboBox1.Value = "NASI" Then
With ws
ws4.Cells(iRow4, 1).Value = Me.TextBox1.Value
ws4.Cells(iRow4, 2).Value = Me.TextBox2.Value
End With
End If
'clear data
Me.TextBox1.Value = ""
Me.TextBox2.Value = ""
Me.TextBox1.SetFocus
MsgBox "DATA TELAH DI SIMPAN"
End Sub
3.A. Input data berdasarkan kolom pencarian 1
Dim Kode
Dim CellTujuan As Range
Kode = TextBox1.Value
Set CellTujuan = Range("C3:ZZ3").Find(What:=Kode,
LookIn:=xlValues, LookAt:=xlWhole)
If Not CellTujuan Is Nothing Then
TextBox2 = Cells(4, CellTujuan.Column)
End If
iRow = ws.Cells(Rows.Count, CellTujuan.Column) _
.End(xlUp).Offset(1, CellTujuan.Column).Row
ws.Cells(iRow, CellTujuan.Column).Value = Textbox2.Value
3.B.Input data berdasarkan kolom pencarian 2
Dim x As Range
For Each x In Range("A1:Z100")
If x.Value = CStr(TextBox1.Value) Then
TextBox2.Value = x.Offset(1, 0).Value
End If
Next
iRow = ws.Cells(Rows.Count, x.Column) _
.End(xlUp).Offset(1, x.Column).Row
ws.Cells(iRow, x.Column).Value = Textbox2.Value
4. Input data KEDALAM SHEET, NAMA SHEET SESUAI TEXTBOX
Dim iRow As Long
Dim ws As Worksheet
nama = TextBulan.value
Set ws = Worksheets(nama)
‘menemukan baris kosong pada database
iRow = ws.Cells(Rows.Count, 1) _
.End(xlUp).Offset(1, 0).Row
‘check untuk sebuah kode
If Trim(TextBox1.Value) = “” Then
TextBox1.SetFocus
MsgBox “Masukan Kode Barang”
Exit Sub
End If
‘copy data ke database
ws.Cells(iRow, 1).Value = TextBox1.Value
ws.Cells(iRow, 2).Value = TextBox2.Value
ws.Cells(iRow, 3).Value = TextBox3.Value
ws.Cells(iRow, 4).Value = TextBox4.Value
‘clear data
TextBox1.Value = “”
TextBox2.Value = “”
TextBox3.Value = “”
TextBox4.Value = “”
TextBox1.SetFocus
END SUB
Langganan:
Postingan (Atom)