15 New Messages
Digest #1952
Messages
Wed Dec 5, 2012 10:07 pm (PST) . Posted by:
"ngademin Thohari" ngademinth
Be-exceller, mr kid
Terimakasih atas sharing ilmunya selama ini, setelah saya coba memasukkan script satu persatu, masih ada kendala yang saya hadapi, yaitu
1. data tidak bisa ter sorting
2. penunjukan rack id tidak menunjukkan semestinya, walaupun rack idnya sama
3. quantity tidak terjumlah
mohon pencerahannya lagi
terima kasih
amin
Option Explicit
Private Sub TbPartno_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim rngData As Range, rng As Range
Dim spart As String, sRackByPart As String
Sheet3.Unprotect "Belajar-Excel"
spart = Trim$(Replace$(UCase$(TbPartno.Text), "3N1", vbNullString))
spart = Left$(spart, InStr(spart & " ", " ") - 1)
Set rngData = Sheet3.Range("c1").CurrentRegion.Resize(, 1).Offset(0, 4)
With rngData
.Parent.AutoFilterMode = False
.AutoFilter 1, spart
If .SpecialCells(xlCellTypeVisible).Count > 1 Then
For Each rng In .Offset(1).SpecialCells(xlCellTypeVisible)
If LenB(rng.Value) <> 0 Then
sRackByPart = Replace$(sRackByPart, "," & spart, vbNullString) & "," & spart
End If
Next rng
sRackByPart = Mid$(sRackByPart, 2)
End If
If LenB(sRackByPart) <> 0 Then
TextBox1.Text = sRackByPart
Else
TextBox1.Text = "Tidak ada rack yang dipakai part " & spart
End If
TextBox1.Locked = True
.Parent.AutoFilterMode = False
End With
Sheet3.Protect "Belajar-Excel", userinterfaceonly:=True
End Sub
Private Sub Tbloc_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim rngData As Range
Dim spart As String, sRack As String
'simpan part tanpa 3n1 dan qty
spart = Trim$(Replace$(UCase$(TbPartno.Text), "3N1", vbNullString)) 'hapus teks '3N1'
spart = Left$(spart, InStr(spart & " ", " ") - 1) 'ambil kode saja (asumsi ada spasi pemisah kode dengan qty)
sRack = Trim$(Tbloc.Text)
'filter data yang ada berdasar spart
Set rngData = Sheet3.Range("c1").CurrentRegion.Resize(, 7).Offset(0, 4)
With rngData
.Parent.AutoFilterMode = False
.Font.Bold = False
.AutoFilter 1, spart
.AutoFilter 7, sRack
If .Resize(, 1).SpecialCells(xlCellTypeVisible).Count > 1 Then
.SpecialCells (xlCellTypeVisible)
'.Font.Bold
TextBox1.Text = "Sudah dipakai part lain"
Else
.Parent.AutoFilterMode = False
End If
TextBox1.Locked = True
End With
End Sub
Private Sub UserForm_Initialize()
Dim ctr As Control
For Each ctr In Me.Controls
If Left(ctr.Name, 2) = "Cb" Then ctr.BackColor = RGB(240, 255, 255)
If Left(ctr.Name, 2) = "Tb" Then ctr.BackColor = RGB(255, 255, 225)
Next ctr
End Sub
Private Sub UserForm_Activate()
CbCust.List = Array("PTIEI", "PTITR", "PTFLUI", "PTSKI", "PTLGIT")
CbCust.ListIndex = 0
CbOpr.List = Array("Purwati", "Ria", "Evi Hudi", "Sarwinah", "Tiwi", "Maurice")
CbOpr.ListIndex = 0
Cbqty.List = Array("0")
Cbqty.ListIndex = 0
End Sub
Private Sub Cbqty_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Select Case KeyCode
Case 8, 48 To 57
Case Else
KeyCode = 0
Beep
End Select
End Sub
Private Sub CmdInput_Click()
Dim LastRow As Range, Respons
Dim ctrl As Control
Dim spart As Variant
Sheet3.Unprotect "Belajar-Excel"
On Error Resume Next
Set LastRow = Sheet3.Range("C10000").End(xlUp)
For Each ctrl In Me.Controls
If TypeName(ctrl) = "TextBox" Then
If Left(ctrl.Name, 2) = "Tb" And ctrl.Value = "" Then
MsgBox ctrl.Name & " belum diisi !!", 48, "Material Input Control"
Exit Sub
End If
End If
Next ctrl
spart = Trim$(Replace$(UCase$(TbPartno.Text), "3N1", vbNullString))
spart = Left$(spart, InStr(spart & " ", " ") - 1)
If IsNumeric(spart) Then
spart = CLng(spart)
End If
With LastRow
.Cells(2, 1) = Tbloc.Value
.Cells(2, 2) = Cbcons
.Cells(2, 3) = CbCust
.Cells(2, 5).Value = spart
.Cells(2, 6) = TbLot.Value
.Cells(2, 7) = TbPartname.Value
.Cells(2, 8) = Cbqty.Value
.Cells(2, 9) = CbOpr
End With
Sheet3.Range("A1").Select
Respons = MsgBox("Data masuk dengan sukses, Lanjutkan Input ?", 4, "Material Input Success")
If Respons = vbNo Then Unload Me
For Each ctrl In Me.Controls
If Left(ctrl.Name, 2) = "Tb" Then ctrl = ""
Next ctrl
Sheet3.Range("c1").CurrentRegion.Sort Sheet3.Range("g1"), xlAscending, Header:=xlYes, Orientation:=xlSortColumns
Sheet3.Protect "Belajar-Excel", userinterfaceonly:=True
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = vbFormControlMenu Then Cancel = True
End Sub
Private Sub CmdCancel_Click()
Unload Me
End Sub
________________________________
Dari: Mr. Kid <mr.nmkid@gmail.com >
Kepada: belajar-excel@yahoogroups.com
Dikirim: Selasa, 4 Desember 2012 22:14
Judul: Re: [belajar-excel] tracebility part gudang
Pada event partno exit :
- semua vNilai diganti dengan sPart
- sRackByPart = blabla diganti menjadi :
sRackByPart = Replace$(sRackByPart, "," & sPart,vbnullstring) & "," & sPart
- buka proteksi sheet lebih dulu. Kemudian akhir dengan proteksi sheet. Cara proteksi diset agar proteksi hanya untuk userinterface saja. Bunyi proteksi :
sheets("nama sheetnya").protect "passwordnya",userinterfaceonly:=true
Wassalam,
Kid.
2012/12/3 ngademin Thohari <ngademinth@yahoo.co.id >
>
>Be-Exceller, mr. kid
>
>
>Mohon diverifikasi pekerjaan saya, saya coba program tidak berjalan dengan semestinya,
>
>
>
>
>Option Explicit
>
>
>Private Sub UserForm_Initialize()
> Dim ctr As Control
> For Each ctr In Me.Controls
> If Left(ctr.Name, 2) = "Cb" Then ctr.BackColor = RGB(240, 255, 255)
> If Left(ctr.Name, 2) = "Tb" Then ctr.BackColor = RGB(255, 255, 225)
> Next ctr
>End Sub
>
>
>Private Sub UserForm_Activate()
> 'CbType.List = Array("Model1", "Model2", "Model3", "Model4", "Model5", "Model6", "Model7", "Model8")
> 'CbType.ListIndex = 0
> CbCust.List = Array("PTIEI", "PTITR", "PTFLUI", "PTSKI", "PTLGIT")
> CbCust.ListIndex = 0
> CbOpr.List = Array("Purwati", "Ria", "Evi Hudi", "Sarwinah", "Tiwi", "Maurice")
> CbOpr.ListIndex = 0
> Cbqty.List = Array("0")
> Cbqty.ListIndex = 0
> 'Cbloc.List = Array("78P1WP02-R01-", "78P1WP02-R02-", "78P1WP02-R03-", "78P1WP02-R04-", "78P1WP02-R05-", "78P1WP02-R06-", "78P1WP02-R07", "78P1WP02-R08", "78P1WP02-R09", "78P1WP02-R10", "78P1WP02-R11", "78P1WP02-R12", "78P1WP02-R13", "78P1WP02-R14", "78P1WP02-R15")
> 'Cbloc.ListIndex = 0
> Cbcons.List = Array("Bali-1", "A14..", "Common")
> 'Cbcons.ListIndex = 0
>
>
> 'CbDate = Format(Now, "dd/mm/yyyy hh:mm:ss")
>End Sub
>Private Sub Cbqty_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
>Select Case KeyCode
>Case 8, 48 To 57 'tombol back atau tombol angka dari 0 sampai 9
>Case Else 'lainnya
> KeyCode = 0 'gak ada yang dipencet
>
>
> 'pesan : (udah gak jaman lagi ngrusuhi user yang lagi fokus ngisi dengan munculnya msgbox)
> Beep 'sound dikit, daripada keluar msgbox yang mengganggu user
>End Select
>End Sub
>Private Sub CmdInput_Click()
> Dim LastRow As Range, Respons
> Dim ctrl As Control
> Sheet3.Unprotect "Belajar-Excel"
> On Error Resume Next
> Set LastRow = Sheet3.Range("C10000").End(xlUp)
> For Each ctrl In Me.Controls
> If TypeName(ctrl) = "TextBox" Then
> If Left(ctrl.Name, 2) = "Tb" And ctrl.Value = "" Then
> MsgBox ctrl.Name & " belum diisi !!", 48, "Material Input Control"
> Exit Sub
> End If
> End If
> Next ctrl
> 'pengolah data partno
>Dim vNilai As Variant
>
>
>vNilai = Trim$(Replace$(UCase$(TbPartno.Text), "3N1", vbNullString)) 'hapus teks '3N1'
>vNilai = Left$(vNilai, InStr(vNilai & " ", " ") - 1) 'ambil kode saja (asumsi ada spasi pemisah kode dengan qty)
>
>
>'buat jaga-jaga, siapa tahu Excel gak mau auto convert tipedata saat ditulisi di bagian with di bawah sana
>If IsNumeric(vNilai) Then 'cek isinya bisa jadi bilangan
> vNilai = CLng(vNilai) 'konversi tipe data
>End If
>
>
> With LastRow
> .Cells(2, 1) = Tbloc.Value
> .Cells(2, 11) = Tbloc.Value
> .Cells(2, 2) = Cbcons
> .Cells(2, 3) = CbCust
> '.Cells(2, 4) = CbDate
> .Cells(2, 5).Value = vNilai
> .Cells(2, 6) = TbLot.Value
> .Cells(2, 7) = TbPartname.Value
> .Cells(2, 8) = Cbqty.Value
> .Cells(2, 9) = CbOpr
> End With
> Sheet3.Range("A1").Select
> Respons = MsgBox("Data masuk dengan sukses, Lanjutkan Input ?", 4, "Material Input Success")
> If Respons = vbNo Then Unload Me
>
> For Each ctrl In Me.Controls
> If Left(ctrl.Name, 2) = "Tb" Then ctrl = ""
> Next ctrl
>
> Sheet3.Protect "Belajar-Excel"
> 'set sortcolumns -> siapa tahu pernah dipakai sort rows
>Sheet3.Range("c1").CurrentRegion.Sort
>Sheet3.Range ("g1"), xlAscending, Header:=xlYes, Orientation:=xlSortColumns
>
>
>End Sub
>
>
>Private Sub TbPartno_Exit(ByVal Cancel As MSForms.ReturnBoolean)
>Dim rngData As Range, rng As Range
>Dim sPart As String, sRackByPart As String
>
>
>'simpan part tanpa 3n1 dan qty
>sPart = Trim$(Replace$(UCase$(TbPartno.Text), "3N1", vbNullString)) 'hapus teks '3N1'
>sPart = Left$(vNilai, InStr(sPart & " ", " ") - 1) 'ambil kode saja (asumsi ada spasi pemisah kode dengan qty)
>
>
>'filter data yang ada berdasar spart
>Set rngData = Sheet3.Range("c1").CurrentRegion.Resize(, 1).Offset(0, 4)
>With rngData
> .Parent.AutoFilterMode = False
> .AutoFilter 1, sPart
> If .SpecialCells(xlCellTypeVisible).Count > 1 Then
> For Each rng In .Offset(1).SpecialCells(xlCellTypeVisible)
> If LenB(rng.Value) <> 0 Then
> sRackByPart = Replace$(sRackByPart, "," & sPart) & "," & sPart
> End If
> Next rng
> sRackByPart = Mid$(sRackByPart, 2)
> End If
>
>
> If LenB(sRackByPart) <> 0 Then
> TextBox1.Text = sRackByPart
> Else
> TextBox1.Text = "Tidak ada rack yang dipakai part " & sPart
> End If
> TextBox1.Locked = True
> .Parent.AutoFilterMode = False
>End With
>End Sub
>Private Sub Tbloc_Exit(ByVal Cancel As MSForms.ReturnBoolean)
>Dim rngData As Range
>Dim sPart As String, sRack As String
>
>
>'simpan part tanpa 3n1 dan qty
>sPart = Trim$(Replace$(UCase$(TbPartno.Text), "3N1", vbNullString)) 'hapus teks '3N1'
>sPart = Left$(vNilai, InStr(sPart & " ", " ") - 1) 'ambil kode saja (asumsi ada spasi pemisah kode dengan qty)
>sRack = Trim$(Tbloc.Text)
>
>
>'filter data yang ada berdasar spart
>Set rngData = Sheet3.Range("c1").CurrentRegion.Resize(, 7).Offset(0, 4)
>With rngData
> .Parent.AutoFilterMode = False
> .Font.Bold = False
> .AutoFilter 1, sPart
> .AutoFilter 7, sRack
> If .Resize(, 1).SpecialCells(xlCellTypeVisible).Count > 1 Then
> .SpecialCells(xlCellTypeVisible).Font.Bold
> TextBox1.Text = "Sudah dipakai part lain"
> Else
> .Parent.AutoFilterMode = False
> End If
> TextBox1.Locked = True
>End With
>End Sub
>
>
>Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
> If CloseMode = vbFormControlMenu Then Cancel = True
>End Sub
>
>
>Private Sub CmdCancel_Click()
> Unload Me
>End Sub
>
>
>terima kasih
>
>
>Dwi amin
>
>
>
>
>
>________________________________
>
>
Terimakasih atas sharing ilmunya selama ini, setelah saya coba memasukkan script satu persatu, masih ada kendala yang saya hadapi, yaitu
1. data tidak bisa ter sorting
2. penunjukan rack id tidak menunjukkan semestinya, walaupun rack idnya sama
3. quantity tidak terjumlah
mohon pencerahannya lagi
terima kasih
amin
Option Explicit
Private Sub TbPartno_Exit(
Dim rngData As Range, rng As Range
Dim spart As String, sRackByPart As String
Sheet3.Unprotect "Belajar-Excel"
spart = Trim$(Replace$
spart = Left$(spart, InStr(spart & " ", " ") - 1)
Set rngData = Sheet3.Range(
With rngData
.Parent.AutoFilterM
.AutoFilter 1, spart
If .SpecialCells(
For Each rng In .Offset(1).SpecialC
If LenB(rng.Value) <> 0 Then
sRackByPart = Replace$(sRackByPar
End If
Next rng
sRackByPart = Mid$(sRackByPart, 2)
End If
If LenB(sRackByPart) <> 0 Then
TextBox1.Text = sRackByPart
Else
TextBox1.Text = "Tidak ada rack yang dipakai part " & spart
End If
TextBox1.Locked = True
.Parent.AutoFilterM
End With
Sheet3.Protect "Belajar-Excel"
End Sub
Private Sub Tbloc_Exit(ByVal Cancel As MSForms.ReturnBoole
Dim rngData As Range
Dim spart As String, sRack As String
'simpan part tanpa 3n1 dan qty
spart = Trim$(Replace$
spart = Left$(spart, InStr(spart & " ", " ") - 1) 'ambil kode saja (asumsi ada spasi pemisah kode dengan qty)
sRack = Trim$(Tbloc.
'filter data yang ada berdasar spart
Set rngData = Sheet3.Range(
With rngData
.Parent.AutoFilterM
.Font.Bold = False
.AutoFilter 1, spart
.AutoFilter 7, sRack
If .Resize(, 1).SpecialCells(
.SpecialCells (xlCellTypeVisible)
'.Font.Bold
TextBox1.Text = "Sudah dipakai part lain"
Else
.Parent.AutoFilterM
End If
TextBox1.Locked = True
End With
End Sub
Private Sub UserForm_Initialize
Dim ctr As Control
For Each ctr In Me.Controls
If Left(ctr.Name, 2) = "Cb" Then ctr.BackColor = RGB(240, 255, 255)
If Left(ctr.Name, 2) = "Tb" Then ctr.BackColor = RGB(255, 255, 225)
Next ctr
End Sub
Private Sub UserForm_Activate(
CbCust.List = Array("PTIEI"
CbCust.ListIndex = 0
CbOpr.List = Array("Purwati"
CbOpr.ListIndex = 0
Cbqty.List = Array("0")
Cbqty.ListIndex = 0
End Sub
Private Sub Cbqty_KeyDown(
Select Case KeyCode
Case 8, 48 To 57
Case Else
KeyCode = 0
Beep
End Select
End Sub
Private Sub CmdInput_Click(
Dim LastRow As Range, Respons
Dim ctrl As Control
Dim spart As Variant
Sheet3.Unprotect "Belajar-Excel"
On Error Resume Next
Set LastRow = Sheet3.Range(
For Each ctrl In Me.Controls
If TypeName(ctrl) = "TextBox" Then
If Left(ctrl.Name, 2) = "Tb" And ctrl.Value = "" Then
MsgBox ctrl.Name & " belum diisi !!", 48, "Material Input Control"
Exit Sub
End If
End If
Next ctrl
spart = Trim$(Replace$
spart = Left$(spart, InStr(spart & " ", " ") - 1)
If IsNumeric(spart) Then
spart = CLng(spart)
End If
With LastRow
.Cells(2, 1) = Tbloc.Value
.Cells(2, 2) = Cbcons
.Cells(2, 3) = CbCust
.Cells(2, 5).Value = spart
.Cells(2, 6) = TbLot.Value
.Cells(2, 7) = TbPartname.Value
.Cells(2, 8) = Cbqty.Value
.Cells(2, 9) = CbOpr
End With
Sheet3.Range(
Respons = MsgBox("Data masuk dengan sukses, Lanjutkan Input ?", 4, "Material Input Success")
If Respons = vbNo Then Unload Me
For Each ctrl In Me.Controls
If Left(ctrl.Name, 2) = "Tb" Then ctrl = ""
Next ctrl
Sheet3.Range(
Sheet3.Protect "Belajar-Excel"
End Sub
Private Sub UserForm_QueryClose
If CloseMode = vbFormControlMenu Then Cancel = True
End Sub
Private Sub CmdCancel_Click(
Unload Me
End Sub
____________
Dari: Mr. Kid <mr.nmkid@gmail.
Kepada: belajar-excel@
Dikirim: Selasa, 4 Desember 2012 22:14
Judul: Re: [belajar-excel] tracebility part gudang
Pada event partno exit :
- semua vNilai diganti dengan sPart
- sRackByPart = blabla diganti menjadi :
sRackByPart = Replace$(sRackByPar
- buka proteksi sheet lebih dulu. Kemudian akhir dengan proteksi sheet. Cara proteksi diset agar proteksi hanya untuk userinterface saja. Bunyi proteksi :
sheets("nama sheetnya").protect "passwordnya"
Wassalam,
Kid.
2012/12/3 ngademin Thohari <ngademinth@yahoo.
>
>Be-Exceller, mr. kid
>
>
>Mohon diverifikasi pekerjaan saya, saya coba program tidak berjalan dengan semestinya,
>
>
>
>
>Option Explicit
>
>
>Private Sub UserForm_Initialize
> Dim ctr As Control
> For Each ctr In Me.Controls
> If Left(ctr.Name, 2) = "Cb" Then ctr.BackColor = RGB(240, 255, 255)
> If Left(ctr.Name, 2) = "Tb" Then ctr.BackColor = RGB(255, 255, 225)
> Next ctr
>End Sub
>
>
>Private Sub UserForm_Activate(
> 'CbType.List = Array("Model1"
> 'CbType.ListIndex = 0
> CbCust.List = Array("PTIEI"
> CbCust.ListIndex = 0
> CbOpr.List = Array("Purwati"
> CbOpr.ListIndex = 0
> Cbqty.List = Array("0")
> Cbqty.ListIndex = 0
> 'Cbloc.List = Array("78P1WP02-
> 'Cbloc.ListIndex = 0
> Cbcons.List = Array("Bali-
> 'Cbcons.ListIndex = 0
>
>
> 'CbDate = Format(Now, "dd/mm/yyyy hh:mm:ss")
>End Sub
>Private Sub Cbqty_KeyDown(
>Select Case KeyCode
>Case 8, 48 To 57 'tombol back atau tombol angka dari 0 sampai 9
>Case Else 'lainnya
> KeyCode = 0 'gak ada yang dipencet
>
>
> 'pesan : (udah gak jaman lagi ngrusuhi user yang lagi fokus ngisi dengan munculnya msgbox)
> Beep 'sound dikit, daripada keluar msgbox yang mengganggu user
>End Select
>End Sub
>Private Sub CmdInput_Click(
> Dim LastRow As Range, Respons
> Dim ctrl As Control
> Sheet3.Unprotect "Belajar-Excel"
> On Error Resume Next
> Set LastRow = Sheet3.Range(
> For Each ctrl In Me.Controls
> If TypeName(ctrl) = "TextBox" Then
> If Left(ctrl.Name, 2) = "Tb" And ctrl.Value = "" Then
> MsgBox ctrl.Name & " belum diisi !!", 48, "Material Input Control"
> Exit Sub
> End If
> End If
> Next ctrl
> 'pengolah data partno
>Dim vNilai As Variant
>
>
>vNilai = Trim$(Replace$
>vNilai = Left$(vNilai, InStr(vNilai & " ", " ") - 1) 'ambil kode saja (asumsi ada spasi pemisah kode dengan qty)
>
>
>'buat jaga-jaga, siapa tahu Excel gak mau auto convert tipedata saat ditulisi di bagian with di bawah sana
>If IsNumeric(vNilai) Then 'cek isinya bisa jadi bilangan
> vNilai = CLng(vNilai) 'konversi tipe data
>End If
>
>
> With LastRow
> .Cells(2, 1) = Tbloc.Value
> .Cells(2, 11) = Tbloc.Value
> .Cells(2, 2) = Cbcons
> .Cells(2, 3) = CbCust
> '.Cells(2, 4) = CbDate
> .Cells(2, 5).Value = vNilai
> .Cells(2, 6) = TbLot.Value
> .Cells(2, 7) = TbPartname.Value
> .Cells(2, 8) = Cbqty.Value
> .Cells(2, 9) = CbOpr
> End With
> Sheet3.Range(
> Respons = MsgBox("Data masuk dengan sukses, Lanjutkan Input ?", 4, "Material Input Success")
> If Respons = vbNo Then Unload Me
>
> For Each ctrl In Me.Controls
> If Left(ctrl.Name, 2) = "Tb" Then ctrl = ""
> Next ctrl
>
> Sheet3.Protect "Belajar-Excel"
> 'set sortcolumns -> siapa tahu pernah dipakai sort rows
>Sheet3.Range(
>Sheet3.Range ("g1"), xlAscending, Header:=xlYes, Orientation:
>
>
>End Sub
>
>
>Private Sub TbPartno_Exit(
>Dim rngData As Range, rng As Range
>Dim sPart As String, sRackByPart As String
>
>
>'simpan part tanpa 3n1 dan qty
>sPart = Trim$(Replace$
>sPart = Left$(vNilai, InStr(sPart & " ", " ") - 1) 'ambil kode saja (asumsi ada spasi pemisah kode dengan qty)
>
>
>'filter data yang ada berdasar spart
>Set rngData = Sheet3.Range(
>With rngData
> .Parent.AutoFilterM
> .AutoFilter 1, sPart
> If .SpecialCells(
> For Each rng In .Offset(1).SpecialC
> If LenB(rng.Value) <> 0 Then
> sRackByPart = Replace$(sRackByPar
> End If
> Next rng
> sRackByPart = Mid$(sRackByPart, 2)
> End If
>
>
> If LenB(sRackByPart) <> 0 Then
> TextBox1.Text = sRackByPart
> Else
> TextBox1.Text = "Tidak ada rack yang dipakai part " & sPart
> End If
> TextBox1.Locked = True
> .Parent.AutoFilterM
>End With
>End Sub
>Private Sub Tbloc_Exit(ByVal Cancel As MSForms.ReturnBoole
>Dim rngData As Range
>Dim sPart As String, sRack As String
>
>
>'simpan part tanpa 3n1 dan qty
>sPart = Trim$(Replace$
>sPart = Left$(vNilai, InStr(sPart & " ", " ") - 1) 'ambil kode saja (asumsi ada spasi pemisah kode dengan qty)
>sRack = Trim$(Tbloc.
>
>
>'filter data yang ada berdasar spart
>Set rngData = Sheet3.Range(
>With rngData
> .Parent.AutoFilterM
> .Font.Bold = False
> .AutoFilter 1, sPart
> .AutoFilter 7, sRack
> If .Resize(, 1).SpecialCells(
> .SpecialCells(
> TextBox1.Text = "Sudah dipakai part lain"
> Else
> .Parent.AutoFilterM
> End If
> TextBox1.Locked = True
>End With
>End Sub
>
>
>Private Sub UserForm_QueryClose
> If CloseMode = vbFormControlMenu Then Cancel = True
>End Sub
>
>
>Private Sub CmdCancel_Click(
> Unload Me
>End Sub
>
>
>terima kasih
>
>
>Dwi amin
>
>
>
>
>
>___________
>
>
Thu Dec 6, 2012 12:50 am (PST) . Posted by:
"ngademin Thohari" ngademinth
ms. jan raisin
2. untuk combo quantity, gunakan event Exit, jadi pada saat keluar dari combo tersebut lakukan perhitungan terhadap seluruh quantity di tabel yang sesuai dengan kriteria yang telah ditentukan, lalu hasilnya dimasukkan ke dalam ListBox1,
bagaimana caranya
terima kasih
amin
________________________________
Dari: Jan Raisin <miss.jan.raisin@gmail.com >
Kepada: belajar-excel@yahoogroups.com
Dikirim: Sabtu, 1 Desember 2012 14:56
Judul: Re: [belajar-excel] tracebility part gudang
Dear pak Amin,
maaf, lagi terburu-buru mau pergi heheheh :D
Jan kasih gambarannya saja ya..
1. untuk yang PartNumber, coba gunakan Mid untuk mengambil data yang diinginkan, mulai dari karakter ke 4 sebanyak 9 karakter, lalu ubah ke tipe Long Integer dengan perintah CLng
2. untuk combo quantity, gunakan event Exit, jadi pada saat keluar dari combo tersebut lakukan perhitungan terhadap seluruh quantity di tabel yang sesuai dengan kriteria yang telah ditentukan, lalu hasilnya dimasukkan ke dalam ListBox1
3. untuk yang lokasi juga gunakan evet Exit seperti di point 2 di atas, jika ditemukan qty > 0 maka masukkan keterangan ke textbox1
semoga berhasil,
Jan pamit dulu, insya ALLAH online lagi mulai minggu malam atau senin pagi
Wassalam,
-Ms. Jan Raisin-
Pada 1 Desember 2012 13:46, ngademin Thohari <ngademinth@yahoo.co.id > menulis:
>
>Be-exceller, miss jan
>
>
>maaf pak vba dengan password : BelajarExcel
> sheet dengan Belajar-Excel
>
>
>mohon maaf, belum dibuka
>
>
>terimakasih koreksinya
>
>
>amin
>
>
>
>________________________________
> Dari: Jan Raisin <miss.jan.raisin@gmail.com >
>Kepada: belajar-excel@yahoogroups.com
>Dikirim: Sabtu, 1 Desember 2012 13:44
>Judul: Re: [belajar-excel] tracebility part gudang
>
>
>
2. untuk combo quantity, gunakan event Exit, jadi pada saat keluar dari combo tersebut lakukan perhitungan terhadap seluruh quantity di tabel yang sesuai dengan kriteria yang telah ditentukan, lalu hasilnya dimasukkan ke dalam ListBox1,
bagaimana caranya
terima kasih
amin
____________
Dari: Jan Raisin <miss.jan.raisin@
Kepada: belajar-excel@
Dikirim: Sabtu, 1 Desember 2012 14:56
Judul: Re: [belajar-excel] tracebility part gudang
Dear pak Amin,
maaf, lagi terburu-buru mau pergi heheheh :D
Jan kasih gambarannya saja ya..
1. untuk yang PartNumber, coba gunakan Mid untuk mengambil data yang diinginkan, mulai dari karakter ke 4 sebanyak 9 karakter, lalu ubah ke tipe Long Integer dengan perintah CLng
2. untuk combo quantity, gunakan event Exit, jadi pada saat keluar dari combo tersebut lakukan perhitungan terhadap seluruh quantity di tabel yang sesuai dengan kriteria yang telah ditentukan, lalu hasilnya dimasukkan ke dalam ListBox1
3. untuk yang lokasi juga gunakan evet Exit seperti di point 2 di atas, jika ditemukan qty > 0 maka masukkan keterangan ke textbox1
semoga berhasil,
Jan pamit dulu, insya ALLAH online lagi mulai minggu malam atau senin pagi
Wassalam,
-Ms. Jan Raisin-
Pada 1 Desember 2012 13:46, ngademin Thohari <ngademinth@yahoo.
>
>Be-exceller, miss jan
>
>
>maaf pak vba dengan password : BelajarExcel
> sheet dengan Belajar-Excel
>
>
>mohon maaf, belum dibuka
>
>
>terimakasih koreksinya
>
>
>amin
>
>
>
>___________
> Dari: Jan Raisin <miss.jan.raisin@
>Kepada: belajar-excel@
>Dikirim: Sabtu, 1 Desember 2012 13:44
>Judul: Re: [belajar-excel] tracebility part gudang
>
>
>
Thu Dec 6, 2012 2:17 am (PST) . Posted by:
"Mr. Kid" nmkid.family@ymail.com
Ternyata tabelnya menggunakan fitur Excel table
1. data tidak bisa ter sorting
>> pada event click tombol simpan, ganti baris :
Sheet3.Range("c1").CurrentRegion.Sort Sheet3.Range("g1"), xlAscending,
Header:=xlYes, Orientation:=xlSortColumns
dengan :
sorting 'panggil prosedur sorting yang ada di module (hasil record macro
Anda)
2. penunjukan rack id tidak menunjukkan semestinya, walaupun rack idnya sama
>> ganti event tbpartno exit dengan :
Private Sub TbPartno_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim rngData As Range, rng As Range
Dim spart As String, sRackByPart As String
Sheet3.Unprotect "Belajar-Excel"
spart = Trim$(Replace$(UCase$(TbPartno.Text), "3N1", vbNullString))
spart = Left$(spart, InStr(spart & " ", " ") - 1)
Set rngData = Sheet3.listobjects(1).range
'.Range("c1").CurrentRegion.Resize(, 1).Offset(0, 4)
With rngData
'.Parent.AutoFilterMode = False
.AutoFilter 1 ', spart
.autofilter 5,spart
If .resize(,1).SpecialCells(xlCellTypeVisible).Count > 1 Then
For Each rng In .Offset(0,4).resize(1).SpecialCells(xlCellTypeVisible)
If LenB(rng.Value) <> 0 and rng.row>1 Then
sRackByPart = Replace$(sRackByPart, "," &
rng.offset(0,6).value, vbNullString) & "," & rng.offset(0,6).value
End If
Next rng
sRackByPart = Mid$(sRackByPart, 2)
End If
If LenB(sRackByPart) <> 0 Then
TextBox1.Text = sRackByPart
Else
TextBox1.Text = "Tidak ada rack yang dipakai part " & spart
End If
TextBox1.Locked = True
'.Parent.AutoFilterMode = False
End With
Sheet3.Protect "Belajar-Excel", userinterfaceonly:=True
End Sub
3. quantity tidak terjumlah
>> pada event partno exit :
- tambahkan baris deklarasi :
dim dblQty as double
- tambahkan baris :
dblqty=dblqty+rng.offset(0,3).value
setelah baris : (dalam if yang ada di dalam for each)
sRackByPart = Replace$(sRackByPart, "," & rng.offset(0,6).value,
vbNullString) & "," & rng.offset(0,6).value
- cari baris :
If LenB(sRackByPart) <> 0 Then
> sebelum baris tersebut, tambahkan :
listbox1.clear 'hapus isinya dulu
> setelah baris tersebut, tambahkan :
listbox1.additem dblqty 'tambah item baru
Jika bukan pada object listbox seperti contoh, maka sesuaikan cara
hapusisi object yang digunakan dan sesuaikan juga cara tulis di object
yang
digunakan.
Wassalam,
Kid.
On Thu, Dec 6, 2012 at 1:04 PM, ngademin Thohari <ngademinth@yahoo.co.id >wrote:
> **
>
>
> Be-exceller, mr kid
>
> Terimakasih atas sharing ilmunya selama ini, setelah saya coba memasukkan
> script satu persatu, masih ada kendala yang saya hadapi, yaitu
>
> 1. data tidak bisa ter sorting
> 2. penunjukan rack id tidak menunjukkan semestinya, walaupun rack idnya
> sama
> 3. quantity tidak terjumlah
>
> mohon pencerahannya lagi
>
> terima kasih
>
> amin
>
> Option Explicit
> Private Sub TbPartno_Exit(ByVal Cancel As MSForms.ReturnBoolean)
> Dim rngData As Range, rng As Range
> Dim spart As String, sRackByPart As String
>
> Sheet3.Unprotect "Belajar-Excel"
>
> spart = Trim$(Replace$(UCase$(TbPartno.Text), "3N1", vbNullString))
> spart = Left$(spart, InStr(spart & " ", " ") - 1)
> Set rngData = Sheet3.Range("c1").CurrentRegion.Resize(, 1).Offset(0, 4)
> With rngData
> .Parent.AutoFilterMode = False
> .AutoFilter 1, spart
> If .SpecialCells(xlCellTypeVisible).Count > 1 Then
> For Each rng In .Offset(1).SpecialCells(xlCellTypeVisible)
> If LenB(rng.Value) <> 0 Then
> sRackByPart = Replace$(sRackByPart, "," & spart,
> vbNullString) & "," & spart
> End If
> Next rng
> sRackByPart = Mid$(sRackByPart, 2)
> End If
>
> If LenB(sRackByPart) <> 0 Then
> TextBox1.Text = sRackByPart
> Else
> TextBox1.Text = "Tidak ada rack yang dipakai part " & spart
> End If
> TextBox1.Locked = True
> .Parent.AutoFilterMode = False
> End With
> Sheet3.Protect "Belajar-Excel", userinterfaceonly:=True
> End Sub
> Private Sub Tbloc_Exit(ByVal Cancel As MSForms.ReturnBoolean)
> Dim rngData As Range
> Dim spart As String, sRack As String
>
> 'simpan part tanpa 3n1 dan qty
> spart = Trim$(Replace$(UCase$(TbPartno.Text), "3N1", vbNullString)) 'hapus
> teks '3N1'
> spart = Left$(spart, InStr(spart & " ", " ") - 1) 'ambil kode saja (asumsi
> ada spasi pemisah kode dengan qty)
> sRack = Trim$(Tbloc.Text)
>
> 'filter data yang ada berdasar spart
> Set rngData = Sheet3.Range("c1").CurrentRegion.Resize(, 7).Offset(0, 4)
> With rngData
> .Parent.AutoFilterMode = False
> .Font.Bold = False
> .AutoFilter 1, spart
> .AutoFilter 7, sRack
> If .Resize(, 1).SpecialCells(xlCellTypeVisible).Count > 1 Then
> .SpecialCells (xlCellTypeVisible)
> '.Font.Bold
> TextBox1.Text = "Sudah dipakai part lain"
> Else
> .Parent.AutoFilterMode = False
> End If
> TextBox1.Locked = True
> End With
> End Sub
> Private Sub UserForm_Initialize()
> Dim ctr As Control
> For Each ctr In Me.Controls
> If Left(ctr.Name, 2) = "Cb" Then ctr.BackColor = RGB(240, 255, 255)
> If Left(ctr.Name, 2) = "Tb" Then ctr.BackColor = RGB(255, 255, 225)
> Next ctr
> End Sub
> Private Sub UserForm_Activate()
> CbCust.List = Array("PTIEI", "PTITR", "PTFLUI", "PTSKI", "PTLGIT")
> CbCust.ListIndex = 0
> CbOpr.List = Array("Purwati", "Ria", "Evi Hudi", "Sarwinah", "Tiwi",
> "Maurice")
> CbOpr.ListIndex = 0
> Cbqty.List = Array("0")
> Cbqty.ListIndex = 0
> End Sub
> Private Sub Cbqty_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal
> Shift As Integer)
> Select Case KeyCode
> Case 8, 48 To 57
> Case Else
> KeyCode = 0
> Beep
> End Select
> End Sub
> Private Sub CmdInput_Click()
> Dim LastRow As Range, Respons
> Dim ctrl As Control
> Dim spart As Variant
> Sheet3.Unprotect "Belajar-Excel"
> On Error Resume Next
> Set LastRow = Sheet3.Range("C10000").End(xlUp)
> For Each ctrl In Me.Controls
> If TypeName(ctrl) = "TextBox" Then
> If Left(ctrl.Name, 2) = "Tb" And ctrl.Value = "" Then
> MsgBox ctrl.Name & " belum diisi !!", 48, "Material Input
> Control"
> Exit Sub
> End If
> End If
> Next ctrl
> spart = Trim$(Replace$(UCase$(TbPartno.Text), "3N1", vbNullString))
> spart = Left$(spart, InStr(spart & " ", " ") - 1)
> If IsNumeric(spart) Then
> spart = CLng(spart)
> End If
>
> With LastRow
> .Cells(2, 1) = Tbloc.Value
> .Cells(2, 2) = Cbcons
> .Cells(2, 3) = CbCust
> .Cells(2, 5).Value = spart
> .Cells(2, 6) = TbLot.Value
> .Cells(2, 7) = TbPartname.Value
> .Cells(2, 8) = Cbqty.Value
> .Cells(2, 9) = CbOpr
> End With
> Sheet3.Range("A1").Select
> Respons = MsgBox("Data masuk dengan sukses, Lanjutkan Input ?", 4,
> "Material Input Success")
> If Respons = vbNo Then Unload Me
>
> For Each ctrl In Me.Controls
> If Left(ctrl.Name, 2) = "Tb" Then ctrl = ""
> Next ctrl
> Sheet3.Range("c1").CurrentRegion.Sort Sheet3.Range("g1"), xlAscending,
> Header:=xlYes, Orientation:=xlSortColumns
> Sheet3.Protect "Belajar-Excel", userinterfaceonly:=True
> End Sub
> Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
> If CloseMode = vbFormControlMenu Then Cancel = True
> End Sub
>
> Private Sub CmdCancel_Click()
> Unload Me
> End Sub
>
>
> ------------------------------
> **
>
>
1. data tidak bisa ter sorting
>> pada event click tombol simpan, ganti baris :
Sheet3.Range(
Header:=xlYes, Orientation:
dengan :
sorting 'panggil prosedur sorting yang ada di module (hasil record macro
Anda)
2. penunjukan rack id tidak menunjukkan semestinya, walaupun rack idnya sama
>> ganti event tbpartno exit dengan :
Private Sub TbPartno_Exit(
Dim rngData As Range, rng As Range
Dim spart As String, sRackByPart As String
Sheet3.Unprotect "Belajar-Excel"
spart = Trim$(Replace$
spart = Left$(spart, InStr(spart & " ", " ") - 1)
Set rngData = Sheet3.listobjects(
'.Range("c1"
With rngData
'.Parent.AutoFilter
.AutoFilter 1 ', spart
.autofilter 5,spart
If .resize(,1).
For Each rng In .Offset(0,4)
If LenB(rng.Value) <> 0 and rng.row>1 Then
sRackByPart = Replace$(sRackByPar
rng.offset(0,
End If
Next rng
sRackByPart = Mid$(sRackByPart, 2)
End If
If LenB(sRackByPart) <> 0 Then
TextBox1.Text = sRackByPart
Else
TextBox1.Text = "Tidak ada rack yang dipakai part " & spart
End If
TextBox1.Locked = True
'.Parent.AutoFilter
End With
Sheet3.Protect "Belajar-Excel"
End Sub
3. quantity tidak terjumlah
>> pada event partno exit :
- tambahkan baris deklarasi :
dim dblQty as double
- tambahkan baris :
dblqty=dblqty+
setelah baris : (dalam if yang ada di dalam for each)
sRackByPart = Replace$(sRackByPar
vbNullString) & "," & rng.offset(0,
- cari baris :
If LenB(sRackByPart) <> 0 Then
> sebelum baris tersebut, tambahkan :
listbox1.clear 'hapus isinya dulu
> setelah baris tersebut, tambahkan :
listbox1.additem dblqty 'tambah item baru
Jika bukan pada object listbox seperti contoh, maka sesuaikan cara
hapusisi object yang digunakan dan sesuaikan juga cara tulis di object
yang
digunakan.
Wassalam,
Kid.
On Thu, Dec 6, 2012 at 1:04 PM, ngademin Thohari <ngademinth@yahoo.
> **
>
>
> Be-exceller, mr kid
>
> Terimakasih atas sharing ilmunya selama ini, setelah saya coba memasukkan
> script satu persatu, masih ada kendala yang saya hadapi, yaitu
>
> 1. data tidak bisa ter sorting
> 2. penunjukan rack id tidak menunjukkan semestinya, walaupun rack idnya
> sama
> 3. quantity tidak terjumlah
>
> mohon pencerahannya lagi
>
> terima kasih
>
> amin
>
> Option Explicit
> Private Sub TbPartno_Exit(
> Dim rngData As Range, rng As Range
> Dim spart As String, sRackByPart As String
>
> Sheet3.Unprotect "Belajar-Excel"
>
> spart = Trim$(Replace$
> spart = Left$(spart, InStr(spart & " ", " ") - 1)
> Set rngData = Sheet3.Range(
> With rngData
> .Parent.AutoFilterM
> .AutoFilter 1, spart
> If .SpecialCells(
> For Each rng In .Offset(1).SpecialC
> If LenB(rng.Value) <> 0 Then
> sRackByPart = Replace$(sRackByPar
> vbNullString) & "," & spart
> End If
> Next rng
> sRackByPart = Mid$(sRackByPart, 2)
> End If
>
> If LenB(sRackByPart) <> 0 Then
> TextBox1.Text = sRackByPart
> Else
> TextBox1.Text = "Tidak ada rack yang dipakai part " & spart
> End If
> TextBox1.Locked = True
> .Parent.AutoFilterM
> End With
> Sheet3.Protect "Belajar-Excel"
> End Sub
> Private Sub Tbloc_Exit(ByVal Cancel As MSForms.ReturnBoole
> Dim rngData As Range
> Dim spart As String, sRack As String
>
> 'simpan part tanpa 3n1 dan qty
> spart = Trim$(Replace$
> teks '3N1'
> spart = Left$(spart, InStr(spart & " ", " ") - 1) 'ambil kode saja (asumsi
> ada spasi pemisah kode dengan qty)
> sRack = Trim$(Tbloc.
>
> 'filter data yang ada berdasar spart
> Set rngData = Sheet3.Range(
> With rngData
> .Parent.AutoFilterM
> .Font.Bold = False
> .AutoFilter 1, spart
> .AutoFilter 7, sRack
> If .Resize(, 1).SpecialCells(
> .SpecialCells (xlCellTypeVisible)
> '.Font.Bold
> TextBox1.Text = "Sudah dipakai part lain"
> Else
> .Parent.AutoFilterM
> End If
> TextBox1.Locked = True
> End With
> End Sub
> Private Sub UserForm_Initialize
> Dim ctr As Control
> For Each ctr In Me.Controls
> If Left(ctr.Name, 2) = "Cb" Then ctr.BackColor = RGB(240, 255, 255)
> If Left(ctr.Name, 2) = "Tb" Then ctr.BackColor = RGB(255, 255, 225)
> Next ctr
> End Sub
> Private Sub UserForm_Activate(
> CbCust.List = Array("PTIEI"
> CbCust.ListIndex = 0
> CbOpr.List = Array("Purwati"
> "Maurice")
> CbOpr.ListIndex = 0
> Cbqty.List = Array("0")
> Cbqty.ListIndex = 0
> End Sub
> Private Sub Cbqty_KeyDown(
> Shift As Integer)
> Select Case KeyCode
> Case 8, 48 To 57
> Case Else
> KeyCode = 0
> Beep
> End Select
> End Sub
> Private Sub CmdInput_Click(
> Dim LastRow As Range, Respons
> Dim ctrl As Control
> Dim spart As Variant
> Sheet3.Unprotect "Belajar-Excel"
> On Error Resume Next
> Set LastRow = Sheet3.Range(
> For Each ctrl In Me.Controls
> If TypeName(ctrl) = "TextBox" Then
> If Left(ctrl.Name, 2) = "Tb" And ctrl.Value = "" Then
> MsgBox ctrl.Name & " belum diisi !!", 48, "Material Input
> Control"
> Exit Sub
> End If
> End If
> Next ctrl
> spart = Trim$(Replace$
> spart = Left$(spart, InStr(spart & " ", " ") - 1)
> If IsNumeric(spart) Then
> spart = CLng(spart)
> End If
>
> With LastRow
> .Cells(2, 1) = Tbloc.Value
> .Cells(2, 2) = Cbcons
> .Cells(2, 3) = CbCust
> .Cells(2, 5).Value = spart
> .Cells(2, 6) = TbLot.Value
> .Cells(2, 7) = TbPartname.Value
> .Cells(2, 8) = Cbqty.Value
> .Cells(2, 9) = CbOpr
> End With
> Sheet3.Range(
> Respons = MsgBox("Data masuk dengan sukses, Lanjutkan Input ?", 4,
> "Material Input Success")
> If Respons = vbNo Then Unload Me
>
> For Each ctrl In Me.Controls
> If Left(ctrl.Name, 2) = "Tb" Then ctrl = ""
> Next ctrl
> Sheet3.Range(
> Header:=xlYes, Orientation:
> Sheet3.Protect "Belajar-Excel"
> End Sub
> Private Sub UserForm_QueryClose
> If CloseMode = vbFormControlMenu Then Cancel = True
> End Sub
>
> Private Sub CmdCancel_Click(
> Unload Me
> End Sub
>
>
> ------------
> **
>
>
Wed Dec 5, 2012 11:46 pm (PST) . Posted by:
"jonson_ringo" jonson_ringo
dear mister kid,
saya bingung buat rumus untuk menghitung tarif progesif,
1. jika customer A pencapaiannya 85% maka tarifnya adalah 1.25 % dari total penjualannya ( perhitungan Progresif)
2. jika customer A pencapaiannya 100% maka tarifnya adalah 5.00 % dari total penjualannya(karena perhitungan progresif, otomatis customer tersebut akan dihitung juga di level 85%)
3. begitu juga seterusnya
mohon pencerahannya ya pak.
--- In belajar-excel@yahoogroups.com , "Mr. Kid" <mr.nmkid@...> wrote:
>
> Pak Jonson,
>
> Mungkin sebaiknya Bapak menjelaskan lebih rinci tentang hal-hal yang akan
> dikalkulasi.
> Bisa jadi banyak BeExceller yang tidak memahami kasus seperti demikian
> karena bidang kerjanya berbeda dengan Anda.
>
> Wassalam,
> Kid.
>
> 2012/11/23 jonson dahrino <jonson_dahry@...>
>
> > **
> >
> >
> > Dear master excel,
> > saya sudah hampir nyerah nih dengan kasusu in (heheheheh.....)
> > mohon bantuannya ya..
> >
> > pada intinya adalh perhitungan bonus dengan berbagai kriteria dan level
> > pencapaiannya
> >
> > aturannya ada di sheet scheme dan bonusnya dihitung progresif
> >
> > saya lampirkan filenya juga :
> >
> >
> >
> >
>
saya bingung buat rumus untuk menghitung tarif progesif,
1. jika customer A pencapaiannya 85% maka tarifnya adalah 1.25 % dari total penjualannya ( perhitungan Progresif)
2. jika customer A pencapaiannya 100% maka tarifnya adalah 5.00 % dari total penjualannya(
3. begitu juga seterusnya
mohon pencerahannya ya pak.
--- In belajar-excel@
>
> Pak Jonson,
>
> Mungkin sebaiknya Bapak menjelaskan lebih rinci tentang hal-hal yang akan
> dikalkulasi.
> Bisa jadi banyak BeExceller yang tidak memahami kasus seperti demikian
> karena bidang kerjanya berbeda dengan Anda.
>
> Wassalam,
> Kid.
>
> 2012/11/23 jonson dahrino <jonson_dahry@
>
> > **
> >
> >
> > Dear master excel,
> > saya sudah hampir nyerah nih dengan kasusu in (heheheheh..
> > mohon bantuannya ya..
> >
> > pada intinya adalh perhitungan bonus dengan berbagai kriteria dan level
> > pencapaiannya
> >
> > aturannya ada di sheet scheme dan bonusnya dihitung progresif
> >
> > saya lampirkan filenya juga :
> >
> >
> >
> >
>
Thu Dec 6, 2012 12:49 am (PST) . Posted by:
"Hobys Mengamati"
Mr. Kid, kalo saya mau yg 6 digit kenapa ga bisa ya ? trims
--- On Mon, 12/3/12, Mr. Kid <mr.nmkid@gmail.com > wrote:
Pak Hoby,
Semua prosedur dalam Module1 yang berkaitan dengan
fungsi bernama Permutasi harus ada agar fungsi Permutasi dapat digunakan
seperti Bapak menggunakan fungsi bawaan Excel lainnya. Bapak bisa
meng-copy script dalam module tersebut ke module di file lain.
Jika prosedur fungsi Permutasi beserta seluruh prosedur yang
dibutuhkan tidak ada, maka fungsi Permutasi tidak dapat digunakan dalam
worksheet.
Fungsi Permutasi digunakan untuk menyusun daftar permutasi
item. Fungsi Index digunakan untuk merujuk ke suatu array data. Jadi
fungsi Index bukanlah penyusun daftar permutasi. Jika hanya menggunakan
fungsi Index, maka tidak akan didapatkan data apapun karena data daftar
permutasi didapat menggunakan fungsi Permutasi.
File berisi module Permutasi bisa di save as Excel Add-In (.xla).
Semua komputer yang memiliki file add in tersebut dan sudah
mengaktifkannya akan dapat menggunakan fungsi tersebut diseluruh
workbook yang dibukanya.
Wassalam,
Kid.
--- On Mon, 12/3/12, Mr. Kid <mr.nmkid@gmail.
Pak Hoby,
Semua prosedur dalam Module1 yang berkaitan dengan
fungsi bernama Permutasi harus ada agar fungsi Permutasi dapat digunakan
seperti Bapak menggunakan fungsi bawaan Excel lainnya. Bapak bisa
meng-copy script dalam module tersebut ke module di file lain.
Jika prosedur fungsi Permutasi beserta seluruh prosedur yang
dibutuhkan tidak ada, maka fungsi Permutasi tidak dapat digunakan dalam
worksheet.
Fungsi Permutasi digunakan untuk menyusun daftar permutasi
item. Fungsi Index digunakan untuk merujuk ke suatu array data. Jadi
fungsi Index bukanlah penyusun daftar permutasi. Jika hanya menggunakan
fungsi Index, maka tidak akan didapatkan data apapun karena data daftar
permutasi didapat menggunakan fungsi Permutasi.
File berisi module Permutasi bisa di save as Excel Add-In (.xla).
Semua komputer yang memiliki file add in tersebut dan sudah
mengaktifkannya akan dapat menggunakan fungsi tersebut diseluruh
workbook yang dibukanya.
Wassalam,
Kid.
Thu Dec 6, 2012 12:53 am (PST) . Posted by:
"Mr. Kid" nmkid.family@ymail.com
Coba formula : (susun data terdiri dari 6 nilai dari 6 data tersedia)
=Permutasi($a$1:$a$6,6,0)
Dimana A1:A6 berisi data yang akan disusun permutasinya (6 data)
Wassalam,
Kid.
2012/12/6 Hobys Mengamati <hobysmengamati@yahoo.com >
> **
>
>
> Mr. Kid, kalo saya mau yg 6 digit kenapa ga bisa ya ? trims
>
>
> --- On *Mon, 12/3/12, Mr. Kid <mr.nmkid@gmail.com >* wrote:
>
> Pak Hoby,
>
> Semua prosedur dalam Module1 yang berkaitan dengan fungsi bernama
> Permutasi harus ada agar fungsi Permutasi dapat digunakan seperti Bapak
> menggunakan fungsi bawaan Excel lainnya. Bapak bisa meng-copy script dalam
> module tersebut ke module di file lain.
>
> Jika prosedur fungsi Permutasi beserta seluruh prosedur yang dibutuhkan
> tidak ada, maka fungsi Permutasi tidak dapat digunakan dalam worksheet.
> Fungsi Permutasi digunakan untuk menyusun daftar permutasi item. Fungsi
> Index digunakan untuk merujuk ke suatu array data. Jadi fungsi Index
> bukanlah penyusun daftar permutasi. Jika hanya menggunakan fungsi Index,
> maka tidak akan didapatkan data apapun karena data daftar permutasi didapat
> menggunakan fungsi Permutasi.
>
> File berisi module Permutasi bisa di save as Excel Add-In (.xla). Semua
> komputer yang memiliki file add in tersebut dan sudah mengaktifkannya akan
> dapat menggunakan fungsi tersebut diseluruh workbook yang dibukanya.
>
> Wassalam,
> Kid.
>
>
>
=Permutasi($
Dimana A1:A6 berisi data yang akan disusun permutasinya (6 data)
Wassalam,
Kid.
2012/12/6 Hobys Mengamati <hobysmengamati@
> **
>
>
> Mr. Kid, kalo saya mau yg 6 digit kenapa ga bisa ya ? trims
>
>
> --- On *Mon, 12/3/12, Mr. Kid <mr.nmkid@gmail.
>
> Pak Hoby,
>
> Semua prosedur dalam Module1 yang berkaitan dengan fungsi bernama
> Permutasi harus ada agar fungsi Permutasi dapat digunakan seperti Bapak
> menggunakan fungsi bawaan Excel lainnya. Bapak bisa meng-copy script dalam
> module tersebut ke module di file lain.
>
> Jika prosedur fungsi Permutasi beserta seluruh prosedur yang dibutuhkan
> tidak ada, maka fungsi Permutasi tidak dapat digunakan dalam worksheet.
> Fungsi Permutasi digunakan untuk menyusun daftar permutasi item. Fungsi
> Index digunakan untuk merujuk ke suatu array data. Jadi fungsi Index
> bukanlah penyusun daftar permutasi. Jika hanya menggunakan fungsi Index,
> maka tidak akan didapatkan data apapun karena data daftar permutasi didapat
> menggunakan fungsi Permutasi.
>
> File berisi module Permutasi bisa di save as Excel Add-In (.xla). Semua
> komputer yang memiliki file add in tersebut dan sudah mengaktifkannya akan
> dapat menggunakan fungsi tersebut diseluruh workbook yang dibukanya.
>
> Wassalam,
> Kid.
>
>
>
Thu Dec 6, 2012 12:50 am (PST) . Posted by:
"Prodev SIMPLE PB" prodev_simple
Assalamu'alaikum Wr. Wb.
Dear Master,
Ada permasalahan sederhana yang ingin saya tanyakan.
Hal ini berkaitan dengan memindahkan sebuah nilai pada satu kolom ke kolom lain berdasarkan parameter yang diberikan di kolom lain.
Contoh file terlampir.
Terima kasih banyak atas bantuan solusinya.
Wassalam.
- prodev simple -
Dear Master,
Ada permasalahan sederhana yang ingin saya tanyakan.
Hal ini berkaitan dengan memindahkan sebuah nilai pada satu kolom ke kolom lain berdasarkan parameter yang diberikan di kolom lain.
Contoh file terlampir.
Terima kasih banyak atas bantuan solusinya.
Wassalam.
- prodev simple -
Thu Dec 6, 2012 1:30 am (PST) . Posted by:
"Jan Raisin"
Wa'alaikumsalam wr. wb.,
untuk kasus ini hanya bisa diselesaikan menggunakan VBA, kecuali jika tabel
hasil adalah tabel yang terpisah dan berbeda dari dari tabel input
berikut scriptnya:
Option Explicit
' -------------------------- '
' code by: Ms. Jan Raisin '
' untuk millis Belajar Excel '
' 06 Desember 2012 '
' -------------------------- '
' script ini ditulis di sheet Case dengan event adalah Change / perubahan
Private Sub Worksheet_Change(ByVal Target As Range)
' bekerja dengan cell yang mengalami perubahan
' mulai saat ini sebut saja sebagai cell_target
With Target
' jika cell_target adalah 1 maka
If .Cells.Count = 1 Then
' jika cell_target terletak di baris nomer 3 dan seterusnya
' dan letak cell_targer di kolom 1 atau kolom A maka
If .Row >= 3 And .Column = 1 Then
' jika cell_target diisi dengan angka 1 maka
If .Value = 1 Then
' 2 kolom di sebelah kanan dari cell_target diisi dengan
' suatu nilai yang diambil dari 1 kolom di sebelah
kanan cell_target
.Offset(, 2).Value = .Offset(, 1).Value
' lalu 1 kolom di sebelah kanan cell_target dihapus
nilainya
.Offset(, 1).Value = ""
' ini adalah akhir pengecekan apakah cell_target berisi
nilai 1 atau tidak
End If
' ini adalah akhir dari pengecekan apakah cell_target berada di
kolom A mulai baris nomor 3 dan seterusnya
End If
' ini adalah akhir pengecekan apakah jumlah cell yang diubah adalah
1 cell
End If
' akhir dari bekerja dengan cell_target
End With
' akhir dari prosedur
End Sub
file terlampir semoga sesuai dengan harapan
Wassalamu'alaikum wr. wb.,
-Ms. Jan Raisin-
Pada 6 Desember 2012 15:16, Prodev SIMPLE PB <prodev_simple@yahoo.com >menulis:
> **
>
>
> Assalamu'alaikum Wr. Wb.
>
> Dear Master,
> Ada permasalahan sederhana yang ingin saya tanyakan.
> Hal ini berkaitan dengan memindahkan sebuah nilai pada satu kolom ke kolom
> lain berdasarkan parameter yang diberikan di kolom lain.
> Contoh file terlampir.
> Terima kasih banyak atas bantuan solusinya.
>
> Wassalam.
>
> - prodev simple -
>
>
>
untuk kasus ini hanya bisa diselesaikan menggunakan VBA, kecuali jika tabel
hasil adalah tabel yang terpisah dan berbeda dari dari tabel input
berikut scriptnya:
Option Explicit
' ------------
' code by: Ms. Jan Raisin '
' untuk millis Belajar Excel '
' 06 Desember 2012 '
' ------------
' script ini ditulis di sheet Case dengan event adalah Change / perubahan
Private Sub Worksheet_Change(
' bekerja dengan cell yang mengalami perubahan
' mulai saat ini sebut saja sebagai cell_target
With Target
' jika cell_target adalah 1 maka
If .Cells.Count = 1 Then
' jika cell_target terletak di baris nomer 3 dan seterusnya
' dan letak cell_targer di kolom 1 atau kolom A maka
If .Row >= 3 And .Column = 1 Then
' jika cell_target diisi dengan angka 1 maka
If .Value = 1 Then
' 2 kolom di sebelah kanan dari cell_target diisi dengan
' suatu nilai yang diambil dari 1 kolom di sebelah
kanan cell_target
.Offset(, 2).Value = .Offset(, 1).Value
' lalu 1 kolom di sebelah kanan cell_target dihapus
nilainya
.Offset(, 1).Value = ""
' ini adalah akhir pengecekan apakah cell_target berisi
nilai 1 atau tidak
End If
' ini adalah akhir dari pengecekan apakah cell_target berada di
kolom A mulai baris nomor 3 dan seterusnya
End If
' ini adalah akhir pengecekan apakah jumlah cell yang diubah adalah
1 cell
End If
' akhir dari bekerja dengan cell_target
End With
' akhir dari prosedur
End Sub
file terlampir semoga sesuai dengan harapan
Wassalamu'alaikum wr. wb.,
-Ms. Jan Raisin-
Pada 6 Desember 2012 15:16, Prodev SIMPLE PB <prodev_simple@
> **
>
>
> Assalamu'alaikum Wr. Wb.
>
> Dear Master,
> Ada permasalahan sederhana yang ingin saya tanyakan.
> Hal ini berkaitan dengan memindahkan sebuah nilai pada satu kolom ke kolom
> lain berdasarkan parameter yang diberikan di kolom lain.
> Contoh file terlampir.
> Terima kasih banyak atas bantuan solusinya.
>
> Wassalam.
>
> - prodev simple -
>
>
>
Thu Dec 6, 2012 1:52 am (PST) . Posted by:
"Bagus" bagus4bls
Wa'alaikum salam warohmatullohi wabarokatuhu..
Mungkin begini:
utk kolom Nilai A
=IF(F3=0,B3,"")
copy kebawah
utk kolom Nilai B
=IF(F3=0,"",B3)
copy kebawah
Bagus
----- Original Message -----
From: Prodev SIMPLE PB
To: Belajar Excel Milis
Sent: Thursday, December 06, 2012 3:16 PM
Subject: [belajar-excel] Memindahkan Nilai dari Sebuah Kolom
Assalamu'alaikum Wr. Wb.
Dear Master,
Ada permasalahan sederhana yang ingin saya tanyakan.
Hal ini berkaitan dengan memindahkan sebuah nilai pada satu kolom ke kolom lain berdasarkan parameter yang diberikan di kolom lain.
Contoh file terlampir.
Terima kasih banyak atas bantuan solusinya.
Wassalam.
- prodev simple -
Mungkin begini:
utk kolom Nilai A
=IF(F3=0,B3,
copy kebawah
utk kolom Nilai B
=IF(F3=0,"",
copy kebawah
Bagus
----- Original Message -----
From: Prodev SIMPLE PB
To: Belajar Excel Milis
Sent: Thursday, December 06, 2012 3:16 PM
Subject: [belajar-excel] Memindahkan Nilai dari Sebuah Kolom
Assalamu'alaikum Wr. Wb.
Dear Master,
Ada permasalahan sederhana yang ingin saya tanyakan.
Hal ini berkaitan dengan memindahkan sebuah nilai pada satu kolom ke kolom lain berdasarkan parameter yang diberikan di kolom lain.
Contoh file terlampir.
Terima kasih banyak atas bantuan solusinya.
Wassalam.
- prodev simple -
Thu Dec 6, 2012 2:35 am (PST) . Posted by:
"Mr. Kid" nmkid.family@ymail.com
Wa'alaikumussalam Wr. Wb.
Umumnya, hal seperti ini meletakkan data pada kolom A dan B saja dengan
nama kolom Parameter dan Nilai (bukan Nilai A dan Nilai B)
Kemudian di tempat lain, ada suatu proses penampilan nilai-nilai tersebut
sesuai letaknya. Jika parameter berisi 0, maka nilai A yang terisi dan jika
1 maka nilai B.
Cara ini dapat dilakukan dengan formula seperti formula Pak Bagus dengan
sedikit mengubahnya.
btw,
biasanya hal yang lebih simple demikian malah tidak diminati dan banyak
dikatakan tidak memungkinkan.
Kalau begitu, asumsikan saja :
1. input parameter di kolom A mulai A3 karena header di baris 2.
2. input nilai selalu di kolom B (kolom nilai A) mulai cell B3.
Dengan bantuan protect sheet dengan set locked cells dan conditional
formatting, untuk menampilkan seakan-akan nilainya berpindah kira-kira
sebagai berikut :
(maaf kalau ndak bisa melampirkan file... moga-moga ada yang bersedia
mencoba dan posting ke milis)
1. Blok data di kolom Parameter dan Nilai A -> klik kanan -> format cells
-> tab protection -> hilangkan centang dari locked -> tekan OK
2. Blok data di kolom Nilai B -> klik kanan -> format cells -> tab
protection -> centang opsi Hidden -> OK
3. Blok data di kolom Nilai A dan B (mulai blok dari cell B3) -> ribbon
Home -> group Styles -> Conditional Formatting -> New Rule -> pilih opsi
Use Formula
-> isi formula sebagai berikut :
=index($b$2:$c$2,1,$a3 + 1)<>b$2
-> tekan tombol Format -> tab Font -> pilih warna yang sama dengan
warna latar -> OK sampai kembali ke worksheet
4. Proteksi sheet dengan ribbon Review -> group Changes -> Protect Sheet ->
isi password bila perlu -> tekan OK
5. coba ubah nilai parameter
Wassalamu'alaikum Wr. Wb.
Kid.
2012/12/6 Prodev SIMPLE PB <prodev_simple@yahoo.com >
> **
>
>
> Assalamu'alaikum Wr. Wb.
>
> Dear Master,
> Ada permasalahan sederhana yang ingin saya tanyakan.
> Hal ini berkaitan dengan memindahkan sebuah nilai pada satu kolom ke kolom
> lain berdasarkan parameter yang diberikan di kolom lain.
> Contoh file terlampir.
> Terima kasih banyak atas bantuan solusinya.
>
> Wassalam.
>
> - prodev simple -
>
>
>
Umumnya, hal seperti ini meletakkan data pada kolom A dan B saja dengan
nama kolom Parameter dan Nilai (bukan Nilai A dan Nilai B)
Kemudian di tempat lain, ada suatu proses penampilan nilai-nilai tersebut
sesuai letaknya. Jika parameter berisi 0, maka nilai A yang terisi dan jika
1 maka nilai B.
Cara ini dapat dilakukan dengan formula seperti formula Pak Bagus dengan
sedikit mengubahnya.
btw,
biasanya hal yang lebih simple demikian malah tidak diminati dan banyak
dikatakan tidak memungkinkan.
Kalau begitu, asumsikan saja :
1. input parameter di kolom A mulai A3 karena header di baris 2.
2. input nilai selalu di kolom B (kolom nilai A) mulai cell B3.
Dengan bantuan protect sheet dengan set locked cells dan conditional
formatting, untuk menampilkan seakan-akan nilainya berpindah kira-kira
sebagai berikut :
(maaf kalau ndak bisa melampirkan file... moga-moga ada yang bersedia
mencoba dan posting ke milis)
1. Blok data di kolom Parameter dan Nilai A -> klik kanan -> format cells
-> tab protection -> hilangkan centang dari locked -> tekan OK
2. Blok data di kolom Nilai B -> klik kanan -> format cells -> tab
protection -> centang opsi Hidden -> OK
3. Blok data di kolom Nilai A dan B (mulai blok dari cell B3) -> ribbon
Home -> group Styles -> Conditional Formatting -> New Rule -> pilih opsi
Use Formula
-> isi formula sebagai berikut :
=index($b$2:
-> tekan tombol Format -> tab Font -> pilih warna yang sama dengan
warna latar -> OK sampai kembali ke worksheet
4. Proteksi sheet dengan ribbon Review -> group Changes -> Protect Sheet ->
isi password bila perlu -> tekan OK
5. coba ubah nilai parameter
Wassalamu'alaikum Wr. Wb.
Kid.
2012/12/6 Prodev SIMPLE PB <prodev_simple@
> **
>
>
> Assalamu'alaikum Wr. Wb.
>
> Dear Master,
> Ada permasalahan sederhana yang ingin saya tanyakan.
> Hal ini berkaitan dengan memindahkan sebuah nilai pada satu kolom ke kolom
> lain berdasarkan parameter yang diberikan di kolom lain.
> Contoh file terlampir.
> Terima kasih banyak atas bantuan solusinya.
>
> Wassalam.
>
> - prodev simple -
>
>
>
Thu Dec 6, 2012 3:06 am (PST) . Posted by:
"Jan Raisin"
Assalamu'alaikum wr. wb.,
seperti inikah mr Kid?
Wassalamu'alaikum wr. wb.,
-Ms. Jan Raisin-
Pada 6 Desember 2012 17:35, Mr. Kid <mr.nmkid@gmail.com > menulis:
> **
>
>
> Wa'alaikumussalam Wr. Wb.
>
> Umumnya, hal seperti ini meletakkan data pada kolom A dan B saja dengan
> nama kolom Parameter dan Nilai (bukan Nilai A dan Nilai B)
> Kemudian di tempat lain, ada suatu proses penampilan nilai-nilai tersebut
> sesuai letaknya. Jika parameter berisi 0, maka nilai A yang terisi dan jika
> 1 maka nilai B.
> Cara ini dapat dilakukan dengan formula seperti formula Pak Bagus dengan
> sedikit mengubahnya.
>
> btw,
> biasanya hal yang lebih simple demikian malah tidak diminati dan banyak
> dikatakan tidak memungkinkan.
> Kalau begitu, asumsikan saja :
> 1. input parameter di kolom A mulai A3 karena header di baris 2.
> 2. input nilai selalu di kolom B (kolom nilai A) mulai cell B3.
>
> Dengan bantuan protect sheet dengan set locked cells dan conditional
> formatting, untuk menampilkan seakan-akan nilainya berpindah kira-kira
> sebagai berikut :
> (maaf kalau ndak bisa melampirkan file... moga-moga ada yang bersedia
> mencoba dan posting ke milis)
> 1. Blok data di kolom Parameter dan Nilai A -> klik kanan -> format cells
> -> tab protection -> hilangkan centang dari locked -> tekan OK
> 2. Blok data di kolom Nilai B -> klik kanan -> format cells -> tab
> protection -> centang opsi Hidden -> OK
> 3. Blok data di kolom Nilai A dan B (mulai blok dari cell B3) -> ribbon
> Home -> group Styles -> Conditional Formatting -> New Rule -> pilih opsi
> Use Formula
> -> isi formula sebagai berikut :
> =index($b$2:$c$2,1,$a3 + 1)<>b$2
> -> tekan tombol Format -> tab Font -> pilih warna yang sama dengan
> warna latar -> OK sampai kembali ke worksheet
> 4. Proteksi sheet dengan ribbon Review -> group Changes -> Protect Sheet
> -> isi password bila perlu -> tekan OK
> 5. coba ubah nilai parameter
>
> Wassalamu'alaikum Wr. Wb.
> Kid.
>
>
>
> 2012/12/6 Prodev SIMPLE PB <prodev_simple@yahoo.com >
>
>> **
>>
>>
>> Assalamu'alaikum Wr. Wb.
>>
>> Dear Master,
>> Ada permasalahan sederhana yang ingin saya tanyakan.
>> Hal ini berkaitan dengan memindahkan sebuah nilai pada satu kolom ke
>> kolom lain berdasarkan parameter yang diberikan di kolom lain.
>> Contoh file terlampir.
>> Terima kasih banyak atas bantuan solusinya.
>>
>> Wassalam.
>>
>> - prodev simple -
>>
>>
>
>
seperti inikah mr Kid?
Wassalamu'alaikum wr. wb.,
-Ms. Jan Raisin-
Pada 6 Desember 2012 17:35, Mr. Kid <mr.nmkid@gmail.
> **
>
>
> Wa'alaikumussalam Wr. Wb.
>
> Umumnya, hal seperti ini meletakkan data pada kolom A dan B saja dengan
> nama kolom Parameter dan Nilai (bukan Nilai A dan Nilai B)
> Kemudian di tempat lain, ada suatu proses penampilan nilai-nilai tersebut
> sesuai letaknya. Jika parameter berisi 0, maka nilai A yang terisi dan jika
> 1 maka nilai B.
> Cara ini dapat dilakukan dengan formula seperti formula Pak Bagus dengan
> sedikit mengubahnya.
>
> btw,
> biasanya hal yang lebih simple demikian malah tidak diminati dan banyak
> dikatakan tidak memungkinkan.
> Kalau begitu, asumsikan saja :
> 1. input parameter di kolom A mulai A3 karena header di baris 2.
> 2. input nilai selalu di kolom B (kolom nilai A) mulai cell B3.
>
> Dengan bantuan protect sheet dengan set locked cells dan conditional
> formatting, untuk menampilkan seakan-akan nilainya berpindah kira-kira
> sebagai berikut :
> (maaf kalau ndak bisa melampirkan file... moga-moga ada yang bersedia
> mencoba dan posting ke milis)
> 1. Blok data di kolom Parameter dan Nilai A -> klik kanan -> format cells
> -> tab protection -> hilangkan centang dari locked -> tekan OK
> 2. Blok data di kolom Nilai B -> klik kanan -> format cells -> tab
> protection -> centang opsi Hidden -> OK
> 3. Blok data di kolom Nilai A dan B (mulai blok dari cell B3) -> ribbon
> Home -> group Styles -> Conditional Formatting -> New Rule -> pilih opsi
> Use Formula
> -> isi formula sebagai berikut :
> =index($b$2:
> -> tekan tombol Format -> tab Font -> pilih warna yang sama dengan
> warna latar -> OK sampai kembali ke worksheet
> 4. Proteksi sheet dengan ribbon Review -> group Changes -> Protect Sheet
> -> isi password bila perlu -> tekan OK
> 5. coba ubah nilai parameter
>
> Wassalamu'alaikum Wr. Wb.
> Kid.
>
>
>
> 2012/12/6 Prodev SIMPLE PB <prodev_simple@
>
>> **
>>
>>
>> Assalamu'alaikum Wr. Wb.
>>
>> Dear Master,
>> Ada permasalahan sederhana yang ingin saya tanyakan.
>> Hal ini berkaitan dengan memindahkan sebuah nilai pada satu kolom ke
>> kolom lain berdasarkan parameter yang diberikan di kolom lain.
>> Contoh file terlampir.
>> Terima kasih banyak atas bantuan solusinya.
>>
>> Wassalam.
>>
>> - prodev simple -
>>
>>
>
>
Thu Dec 6, 2012 3:16 am (PST) . Posted by:
"Mr. Kid" nmkid.family@ymail.com
Wa'alaikumussalam Wr. Wb.
Yup ms.
Bagian proteksi sheet rencananya digunakan untuk control user ketika kasus
ternyata sebuah area input.
Makasih ya..
Wassalamu'alaikum Wr. Wb.
Kid.
2012/12/6 Jan Raisin <miss.jan.raisin@gmail.com >
> **
>
>
> Assalamu'alaikum wr. wb.,
>
> seperti inikah mr Kid?
>
> Wassalamu'alaikum wr. wb.,
>
> -Ms. Jan Raisin-
>
> Pada 6 Desember 2012 17:35, Mr. Kid <mr.nmkid@gmail.com > menulis:
>
> **
>>
>>
>> Wa'alaikumussalam Wr. Wb.
>>
>> Umumnya, hal seperti ini meletakkan data pada kolom A dan B saja dengan
>> nama kolom Parameter dan Nilai (bukan Nilai A dan Nilai B)
>> Kemudian di tempat lain, ada suatu proses penampilan nilai-nilai tersebut
>> sesuai letaknya. Jika parameter berisi 0, maka nilai A yang terisi dan jika
>> 1 maka nilai B.
>> Cara ini dapat dilakukan dengan formula seperti formula Pak Bagus dengan
>> sedikit mengubahnya.
>>
>> btw,
>> biasanya hal yang lebih simple demikian malah tidak diminati dan banyak
>> dikatakan tidak memungkinkan.
>> Kalau begitu, asumsikan saja :
>> 1. input parameter di kolom A mulai A3 karena header di baris 2.
>> 2. input nilai selalu di kolom B (kolom nilai A) mulai cell B3.
>>
>> Dengan bantuan protect sheet dengan set locked cells dan conditional
>> formatting, untuk menampilkan seakan-akan nilainya berpindah kira-kira
>> sebagai berikut :
>> (maaf kalau ndak bisa melampirkan file... moga-moga ada yang bersedia
>> mencoba dan posting ke milis)
>> 1. Blok data di kolom Parameter dan Nilai A -> klik kanan -> format cells
>> -> tab protection -> hilangkan centang dari locked -> tekan OK
>> 2. Blok data di kolom Nilai B -> klik kanan -> format cells -> tab
>> protection -> centang opsi Hidden -> OK
>> 3. Blok data di kolom Nilai A dan B (mulai blok dari cell B3) -> ribbon
>> Home -> group Styles -> Conditional Formatting -> New Rule -> pilih opsi
>> Use Formula
>> -> isi formula sebagai berikut :
>> =index($b$2:$c$2,1,$a3 + 1)<>b$2
>> -> tekan tombol Format -> tab Font -> pilih warna yang sama dengan
>> warna latar -> OK sampai kembali ke worksheet
>> 4. Proteksi sheet dengan ribbon Review -> group Changes -> Protect Sheet
>> -> isi password bila perlu -> tekan OK
>> 5. coba ubah nilai parameter
>>
>> Wassalamu'alaikum Wr. Wb.
>> Kid.
>>
>>
>>
>> 2012/12/6 Prodev SIMPLE PB <prodev_simple@yahoo.com >
>>
>>> **
>>>
>>>
>>> Assalamu'alaikum Wr. Wb.
>>>
>>> Dear Master,
>>> Ada permasalahan sederhana yang ingin saya tanyakan.
>>> Hal ini berkaitan dengan memindahkan sebuah nilai pada satu kolom ke
>>> kolom lain berdasarkan parameter yang diberikan di kolom lain.
>>> Contoh file terlampir.
>>> Terima kasih banyak atas bantuan solusinya.
>>>
>>> Wassalam.
>>>
>>> - prodev simple -
>>>
>>>
>>
>
>
Yup ms.
Bagian proteksi sheet rencananya digunakan untuk control user ketika kasus
ternyata sebuah area input.
Makasih ya..
Wassalamu'alaikum Wr. Wb.
Kid.
2012/12/6 Jan Raisin <miss.jan.raisin@
> **
>
>
> Assalamu'alaikum wr. wb.,
>
> seperti inikah mr Kid?
>
> Wassalamu'alaikum wr. wb.,
>
> -Ms. Jan Raisin-
>
> Pada 6 Desember 2012 17:35, Mr. Kid <mr.nmkid@gmail.
>
> **
>>
>>
>> Wa'alaikumussalam Wr. Wb.
>>
>> Umumnya, hal seperti ini meletakkan data pada kolom A dan B saja dengan
>> nama kolom Parameter dan Nilai (bukan Nilai A dan Nilai B)
>> Kemudian di tempat lain, ada suatu proses penampilan nilai-nilai tersebut
>> sesuai letaknya. Jika parameter berisi 0, maka nilai A yang terisi dan jika
>> 1 maka nilai B.
>> Cara ini dapat dilakukan dengan formula seperti formula Pak Bagus dengan
>> sedikit mengubahnya.
>>
>> btw,
>> biasanya hal yang lebih simple demikian malah tidak diminati dan banyak
>> dikatakan tidak memungkinkan.
>> Kalau begitu, asumsikan saja :
>> 1. input parameter di kolom A mulai A3 karena header di baris 2.
>> 2. input nilai selalu di kolom B (kolom nilai A) mulai cell B3.
>>
>> Dengan bantuan protect sheet dengan set locked cells dan conditional
>> formatting, untuk menampilkan seakan-akan nilainya berpindah kira-kira
>> sebagai berikut :
>> (maaf kalau ndak bisa melampirkan file... moga-moga ada yang bersedia
>> mencoba dan posting ke milis)
>> 1. Blok data di kolom Parameter dan Nilai A -> klik kanan -> format cells
>> -> tab protection -> hilangkan centang dari locked -> tekan OK
>> 2. Blok data di kolom Nilai B -> klik kanan -> format cells -> tab
>> protection -> centang opsi Hidden -> OK
>> 3. Blok data di kolom Nilai A dan B (mulai blok dari cell B3) -> ribbon
>> Home -> group Styles -> Conditional Formatting -> New Rule -> pilih opsi
>> Use Formula
>> -> isi formula sebagai berikut :
>> =index($b$2:
>> -> tekan tombol Format -> tab Font -> pilih warna yang sama dengan
>> warna latar -> OK sampai kembali ke worksheet
>> 4. Proteksi sheet dengan ribbon Review -> group Changes -> Protect Sheet
>> -> isi password bila perlu -> tekan OK
>> 5. coba ubah nilai parameter
>>
>> Wassalamu'alaikum Wr. Wb.
>> Kid.
>>
>>
>>
>> 2012/12/6 Prodev SIMPLE PB <prodev_simple@
>>
>>> **
>>>
>>>
>>> Assalamu'alaikum Wr. Wb.
>>>
>>> Dear Master,
>>> Ada permasalahan sederhana yang ingin saya tanyakan.
>>> Hal ini berkaitan dengan memindahkan sebuah nilai pada satu kolom ke
>>> kolom lain berdasarkan parameter yang diberikan di kolom lain.
>>> Contoh file terlampir.
>>> Terima kasih banyak atas bantuan solusinya.
>>>
>>> Wassalam.
>>>
>>> - prodev simple -
>>>
>>>
>>
>
>
Thu Dec 6, 2012 1:53 am (PST) . Posted by:
"rodhy hakim" odhyz83_assasaky
Dear Master,
Mohon bantuannya bagaimana cara membuat format cell dengan menggunakan acuan tabel referensi,
dimana hasilnya nanti untuk format cell yang berwarna merah akan dicopy ke tabel tersendiri.
terimakasih sebelumnya.
salam
odhy
Mohon bantuannya bagaimana cara membuat format cell dengan menggunakan acuan tabel referensi,
dimana hasilnya nanti untuk format cell yang berwarna merah akan dicopy ke tabel tersendiri.
terimakasih sebelumnya.
salam
odhy
Thu Dec 6, 2012 2:48 am (PST) . Posted by:
"Bagus" bagus4bls
Dear Odhy
File terlampir semoga sesuai harapan
Bagus
----- Original Message -----
From: rodhy hakim
To: belajar-excel@yahoogroups.com
Sent: Thursday, December 06, 2012 4:21 PM
Subject: [belajar-excel] Format Cell menggunakan tabel referensi
Dear Master,
Mohon bantuannya bagaimana cara membuat format cell dengan menggunakan acuan tabel referensi,
dimana hasilnya nanti untuk format cell yang berwarna merah akan dicopy ke tabel tersendiri.
terimakasih sebelumnya.
salam
odhy
File terlampir semoga sesuai harapan
Bagus
----- Original Message -----
From: rodhy hakim
To: belajar-excel@
Sent: Thursday, December 06, 2012 4:21 PM
Subject: [belajar-excel] Format Cell menggunakan tabel referensi
Dear Master,
Mohon bantuannya bagaimana cara membuat format cell dengan menggunakan acuan tabel referensi,
dimana hasilnya nanti untuk format cell yang berwarna merah akan dicopy ke tabel tersendiri.
terimakasih sebelumnya.
salam
odhy
Thu Dec 6, 2012 7:15 am (PST) . Posted by:
"kyla_delv" kyla_delv
Dear miss jan,
Saya tertarik dgn cash mba tiny ini, saya ingin mengembangkan pertanyaanya boleh kah? #sambilbersujudmemohon
1. Jika no transaksi dirubah dijadikan id buat vendor apakah msh bisa dijalankan macronya contoh: 12345 u/PT. PRIMA SARI UTAMA
2. Dengan menambahkan 1 kolom dibelakang kolom tax, yaitu kolom status, bagaimana cara memanggil no transaksi tsb dan menambahkan status terbayar yg merujuk pada no transaksi tsb
3. Setiap bulan pasti transaksi itu terjadi dgn vendor yg sama, bagaimana memanggil vendor yg sama yang msh terhutang (tidak ada status terbayar)
Mohon pencerahannya miss
Note: mba tiny maaf saya menggunakan casenya ;)
Salam
Miss Ray
--- In belajar-excel@yahoogroups.com , Jan Raisin <miss.jan.raisin@...> wrote:
>
> Dear mbak Tiny,
>
> waktu menyusun VBA ini, Jan jadi teringat dengan teman lama Jan yang kerja
> di bagian Pajak, dulu Jan sering menemani karena dia harus lembur pulang
> malam dan arah pulangnya searah. Dia memegang laporan pajak 5 anak
> perusahaan seorang diri, Jan pikir dia adalah staf Pajak yang tangguh
> karena setelah dia keluar maka pekerjaannya dihandle oleh 3 orang xixixix :D
>
> andai saja dulu Jan bisa VBA pasti Jan akan bantu supaya teman tersebut
> tidak selalu pulang malam.
>
> cukup curhatnya, berikut adalah kodenya, ditulis ke dalam sebuah VB Editor
> (VBE)
>
> Option Explicit
>
> Sub RekapPPhps23()
> ' deklarasikan variabel dengan tipe data String untuk menyimpan data
> bertipe text
> ' NoTrsk = nomer_transaksi
> ' PKP = nama_pengusaha_kena_pajak
> ' NPWP = nomor_pokok_wajib_pajak
> Dim NoTrsk, PKP, NPWP As String
>
> ' delarasikan variabel dengan tipe data Date untuk menyimpan data
> bertipe tanggal
> ' TglVcr = tanggal_voucher
> Dim TglVcr As Date
>
> ' deklarasikan variabel dengan tipe data Long Integer agar dapat
> menyimpan angka yang sangat besar
> ' NoVcr = nomer_voucher
> Dim NoVcr As Long
>
> ' deklarasikan variabel bertipe Range untuk menyimpan objek berupa
> range atau cell
> ' nantinya pengisian data akan dilakukan berdasarkan proses loop
> terhadap area ini
> ' jika nilai > 0 berarti objek pajak, tarif, dan nilainya akan diambil
> ' rgDPP = range_dasar_pengenaan_pajak (pengasilan brutto)
> ' letaknya mulai cell m13 sampai dengan cell m24
> ' cDPP = tiap-tiap_1_cell_di_dalam_rgDPP
> Dim rgDPP, cDPP As Range
>
> ' deklarasikan variabel bertipe String untuk menyimpan data bertipe Text
> ' ObjPjk = nama_objek_pajak
> Dim ObjPjk As String
>
> ' deklarasikan variabel bertipe Double untuk menyimpan data berupa
> angka dengan bilangan desimal
> ' DPP = dasar_pengenaan_pajak
> ' Tari = tarif_pajak dalam persen
> ' PPhDpt = pajak_penghasilan_yang_dipotong
> Dim DPP, Tarif, PPhDpt As Double
>
> ' matikan dahulu fitur screen update agar vba berjalan lebih cepat
> Application.ScreenUpdating = False
>
> ' aktifkan sheet Form Isi 2
> Sheets("form isi 2").Select
>
> ' masukkan masing-masing nilai ke dalam variabel yang sudah disiapkan
> di awal
> ' contoh, NoTrsk diambil dari nilai di cell i3
> ' untuk merujuk cellnya digunakan perintah Range("alamat_cellnya")
> ' untuk mengambil nilainya digunakan perintah .Value
> ' tanda sama_dengan = berfungsi untuk memasukkan nilai terhadap sebuah
> variabel
> ' yang terletak di sebelah kiri tanda sama_dengan
> NoTrsk = Range("i3").Value
> PKP = Range("i8").Value
> NPWP = Range("i7").Value
> TglVcr = Range("n3").Value
> NoVcr = Range("n4").Value
>
> ' lakukan pengujian terhadap jumlah penghasilan brutto di cell m13
> sampai dengan cell m24
> ' jika ada nilainya maka ambil nama objek pajaknya dari kolom helper
> ' kenapa mesti ada kolom bantu? karena untuk memudahkan dalam mengambil
> nama objek pajak
> ' yang sebelumnya letaknya berantakan (tidak dalam 1 kolom yang sama)
> ' lakukan assign ke variabel rgDPP untuk menentukan letak range datanya
> Set rgDPP = Range("m13:m24")
>
> ' lakukan proses loop terhadap setiap 1 cell di dalam rgDpp
> For Each cDPP In rgDPP
>
> ' jika nilai setiap cell di dalam cDPP lebih besar dari nol, maka
> If Len(cDPP.Value) > 0 Then
>
> ' ambil nama objek pajaknya, letaknya 5 kolom di sebelah kanan
> cDPP
> ' untuk merujuknya gunakan perintah Offset
> ' syntax OffSet adalah OffSet(nomer_baris , nomer_kolom)
> ' nomor baris jika bernilai positif berarti turun ke bawah
> ' nomor naris jika bernilai negatif berarti naik ke atas
> ' nomor kolom jika bernilai positif berarti ke arah kanan
> ' nomor kolom jika bernilai negatif berarti ke arah kiri
> ' bahasa manusianya adalah
> ' variabel ObjPjk sama_dengan dari cell cDPP ke arah kanan 5
> kolom lalu ambil nilainya
> ' atau ObjPjk = nilai 5 kolom di sebelah kanan cDPP
> ObjPjk = cDPP.Offset(0, 5).Value
>
> ' lakukan juga untuk yang lainnya
> DPP = cDPP.Value
> Tarif = cDPP.Offset(0, 1).Value
> PPhDpt = cDPP.Offset(0, 2).Value
>
> ' setelah didapat semua nilai yang dibutuhkan, pergi ke sheet
> Rekap PPh 23
> Sheets("rekap pph 23").Select
>
> ' pergi ke cell b3 yang merupakan header dari nomer seri
> transaksi
> Range("b3").Select
>
> ' lakukan pengujian terhadap 1 cell di bawah cell b3
> ' jika tidak ada datanya maka turun 1 baris ke cell b4
> ' jika ada datanya maka pergi ke baris terakhir yang ada datanya
> ' lalu turun lagi 1 baris ke baris baru yang kosong
>
> ' bahasa manusianya:
> ' jika 1 baris di bawah cell aktif tidak ada datanya, maka
> If ActiveCell.Offset(1, 0).Value = "" Then
>
> ' turun 1 baris ke bawah
> ActiveCell.Offset(1, 0).Select
>
> ' karena ini adalah data pertama, maka beri nomer 1 pada 1
> kolom di sebelah kiri
> ActiveCell.Offset(0, -1).Value = 1
>
> ' selain itu
> Else
>
> ' berarti 1 baris di bawahnya ada datanya
> ' turun ke baris terakhir yang ada datanya dengan perintah
> .End(xlDown)
> ' lalu turun 1 baris lagi ke bawah yang kosong dengan
> perintah .Offset(1, 0)
> ActiveCell.End(xlDown).Offset(1, 0).Select
>
> ' karena ini bukan data pertama, maka beri nomor pada 1
> kolom di sebelah kiri
> ' nilainya berasal dari 1 baris di atasnya & 1 kolom di
> sebelah kiri (kiri atas)
> ActiveCell.Offset(0, -1).Value = ActiveCell.Offset(-1,
> -1).Value + 1
>
> ' akhir dari pengecekan data di bawah header
> End If
>
> ' masukkan nilai dari setiap variabel ke tempatnya masing-masing
> ActiveCell.Value = NoTrsk
> ActiveCell.Offset(0, 1).Value = PKP
> ActiveCell.Offset(0, 2).Value = NPWP
> ActiveCell.Offset(0, 3).Value = TglVcr
> ActiveCell.Offset(0, 4).Value = NoVcr
> ActiveCell.Offset(0, 5).Value = ObjPjk
> ActiveCell.Offset(0, 6).Value = DPP
> ActiveCell.Offset(0, 7).Value = Tarif
> ActiveCell.Offset(0, 9).Value = PPhDpt
>
> ' setelah itu kembali lagi ke sheet Form Isi 2 untuk mengambil
> data berikutnya
> Sheets("form isi 2").Select
>
> ' akhir dari penegcekan DPP
> End If
>
> ' lakukan untuk cDPP berikutnya
> Next cDPP
>
> ' aktifkan lagi menu screen update
> Application.ScreenUpdating = True
> End Sub
>
> Cara memanggilnya dengan cara menekan sebuah shape yang sudah di-assign
> dengan macro
>
> untuk formula yang ditanyakan silakan dilihat langsung pada file terlampir
>
> semoga bermanfaat,
>
> Best Regard,
>
> -Ms. Jan Raisin-
>
> 2012/12/4 <hartini_80@...>
>
> > **
> >
> >
> > ** Dear miss jan,
> > Berikut saya kirimkan rekap yang diinginkan, untuk N23 dia mengacu ke
> > sheet tarif, jika memiliki NPWP (cell I7 terisi) maka ditarif yg digunakan
> > itu 2%, jika tidak memiliki npwp 4%
> > Jika tidak menggunakan rekam macro bagaimana carax ya?
> > Mohon bantuannya
> >
> > Salam
> > Tiny
> > Powered by Telkomsel BlackBerry®
> > ------------------------------
> > *From: * Jan Raisin <miss.jan.raisin@...>
> > *Sender: * belajar-excel@yahoogroups.com
> > *Date: *Tue, 4 Dec 2012 12:50:38 +0700
> > *To: *<belajar-excel@yahoogroups.com >
> > *ReplyTo: * belajar-excel@yahoogroups.com
> > *Subject: *Re: [belajar-excel] Fw: Emailing: rekam macro transpose
> >
> >
> >
> > Dear mbak Tini,
> >
> > 1. sebelumnya bisakah dibantu dengan beberapa baris data yang diinginkan
> > di sheet rekap pph 23, karena tidak semua member millis bekerja di bidang
> > yang sama dengan mbak Tini.
> >
> > 2. untuk isian di sheet Form Isi 2 cell N23, yang dimaksud kolom 17 itu
> > cell yang mana ya?
> >
> > maaf, bertanya tanpa urun solusi :D
> >
> > Best Regard,
> >
> > -Ms. Jan Raisin-
> > *kelihatannya untuk kasus ini teknik rekam macro akan lebih sulit
> > dibandingkan dengan menulis script langsung di VBE*
> >
> > 2012/12/4 <hartini_80@...>
> >
> >> **
> >>
> >>
> >> Dear all
> >> Adakah yg bisa mengajakan kepada saya, bagaimana proses rekam makro untuk
> >> transpose
> >> Terima kasih
> >> Salam
> >> Tiny
> >>
> >> Powered by Telkomsel BlackBerry®
> >>
> >> -----Original Message-----
> >> From: Hartini FIN <hartini.fin@...>
> >> Date: Tue, 4 Dec 2012 04:28:07
> >> To: hartini_80@...<hartini_80@...>
> >> Subject: Emailing: rekam macro transpose
> >>
> >>
> >> Your message is ready to be sent with the following file or link
> >> attachments:
> >>
> >> rekam macro transpose
> >>
> >>
> >> Note: To protect against computer viruses, e-mail programs may prevent
> >> sending or receiving certain types of file attachments. Check your e-mail
> >> security settings to determine how attachments are handled.
> >> CONFIDENTIAL NOTE: The information contained in this email is intended
> >> only for the use of the individual or entity named above and may contain
> >> information that is privileged, confidential and exempt from disclosure
> >> under applicable law. If the reader of this message is not the intended
> >> recipient, you are hereby notified that any dissemination, distribution or
> >> copying of this communication is strictly prohibited. If you have received
> >> this message in error, please immediately notify the sender and delete the
> >> mail. Thank you.
> >>
> >>
> >
> >
>
Saya tertarik dgn cash mba tiny ini, saya ingin mengembangkan pertanyaanya boleh kah? #sambilbersujudmemo
1. Jika no transaksi dirubah dijadikan id buat vendor apakah msh bisa dijalankan macronya contoh: 12345 u/PT. PRIMA SARI UTAMA
2. Dengan menambahkan 1 kolom dibelakang kolom tax, yaitu kolom status, bagaimana cara memanggil no transaksi tsb dan menambahkan status terbayar yg merujuk pada no transaksi tsb
3. Setiap bulan pasti transaksi itu terjadi dgn vendor yg sama, bagaimana memanggil vendor yg sama yang msh terhutang (tidak ada status terbayar)
Mohon pencerahannya miss
Note: mba tiny maaf saya menggunakan casenya ;)
Salam
Miss Ray
--- In belajar-excel@
>
> Dear mbak Tiny,
>
> waktu menyusun VBA ini, Jan jadi teringat dengan teman lama Jan yang kerja
> di bagian Pajak, dulu Jan sering menemani karena dia harus lembur pulang
> malam dan arah pulangnya searah. Dia memegang laporan pajak 5 anak
> perusahaan seorang diri, Jan pikir dia adalah staf Pajak yang tangguh
> karena setelah dia keluar maka pekerjaannya dihandle oleh 3 orang xixixix :D
>
> andai saja dulu Jan bisa VBA pasti Jan akan bantu supaya teman tersebut
> tidak selalu pulang malam.
>
> cukup curhatnya, berikut adalah kodenya, ditulis ke dalam sebuah VB Editor
> (VBE)
>
> Option Explicit
>
> Sub RekapPPhps23(
> ' deklarasikan variabel dengan tipe data String untuk menyimpan data
> bertipe text
> ' NoTrsk = nomer_transaksi
> ' PKP = nama_pengusaha_
> ' NPWP = nomor_pokok_
> Dim NoTrsk, PKP, NPWP As String
>
> ' delarasikan variabel dengan tipe data Date untuk menyimpan data
> bertipe tanggal
> ' TglVcr = tanggal_voucher
> Dim TglVcr As Date
>
> ' deklarasikan variabel dengan tipe data Long Integer agar dapat
> menyimpan angka yang sangat besar
> ' NoVcr = nomer_voucher
> Dim NoVcr As Long
>
> ' deklarasikan variabel bertipe Range untuk menyimpan objek berupa
> range atau cell
> ' nantinya pengisian data akan dilakukan berdasarkan proses loop
> terhadap area ini
> ' jika nilai > 0 berarti objek pajak, tarif, dan nilainya akan diambil
> ' rgDPP = range_dasar_
> ' letaknya mulai cell m13 sampai dengan cell m24
> ' cDPP = tiap-tiap_1_
> Dim rgDPP, cDPP As Range
>
> ' deklarasikan variabel bertipe String untuk menyimpan data bertipe Text
> ' ObjPjk = nama_objek_pajak
> Dim ObjPjk As String
>
> ' deklarasikan variabel bertipe Double untuk menyimpan data berupa
> angka dengan bilangan desimal
> ' DPP = dasar_pengenaan_
> ' Tari = tarif_pajak dalam persen
> ' PPhDpt = pajak_penghasilan_
> Dim DPP, Tarif, PPhDpt As Double
>
> ' matikan dahulu fitur screen update agar vba berjalan lebih cepat
> Application.
>
> ' aktifkan sheet Form Isi 2
> Sheets("form isi 2").Select
>
> ' masukkan masing-masing nilai ke dalam variabel yang sudah disiapkan
> di awal
> ' contoh, NoTrsk diambil dari nilai di cell i3
> ' untuk merujuk cellnya digunakan perintah Range("alamat_
> ' untuk mengambil nilainya digunakan perintah .Value
> ' tanda sama_dengan = berfungsi untuk memasukkan nilai terhadap sebuah
> variabel
> ' yang terletak di sebelah kiri tanda sama_dengan
> NoTrsk = Range("i3").
> PKP = Range("i8").
> NPWP = Range("i7").
> TglVcr = Range("n3").
> NoVcr = Range("n4").
>
> ' lakukan pengujian terhadap jumlah penghasilan brutto di cell m13
> sampai dengan cell m24
> ' jika ada nilainya maka ambil nama objek pajaknya dari kolom helper
> ' kenapa mesti ada kolom bantu? karena untuk memudahkan dalam mengambil
> nama objek pajak
> ' yang sebelumnya letaknya berantakan (tidak dalam 1 kolom yang sama)
> ' lakukan assign ke variabel rgDPP untuk menentukan letak range datanya
> Set rgDPP = Range("m13:m24"
>
> ' lakukan proses loop terhadap setiap 1 cell di dalam rgDpp
> For Each cDPP In rgDPP
>
> ' jika nilai setiap cell di dalam cDPP lebih besar dari nol, maka
> If Len(cDPP.Value) > 0 Then
>
> ' ambil nama objek pajaknya, letaknya 5 kolom di sebelah kanan
> cDPP
> ' untuk merujuknya gunakan perintah Offset
> ' syntax OffSet adalah OffSet(nomer_
> ' nomor baris jika bernilai positif berarti turun ke bawah
> ' nomor naris jika bernilai negatif berarti naik ke atas
> ' nomor kolom jika bernilai positif berarti ke arah kanan
> ' nomor kolom jika bernilai negatif berarti ke arah kiri
> ' bahasa manusianya adalah
> ' variabel ObjPjk sama_dengan dari cell cDPP ke arah kanan 5
> kolom lalu ambil nilainya
> ' atau ObjPjk = nilai 5 kolom di sebelah kanan cDPP
> ObjPjk = cDPP.Offset(
>
> ' lakukan juga untuk yang lainnya
> DPP = cDPP.Value
> Tarif = cDPP.Offset(
> PPhDpt = cDPP.Offset(
>
> ' setelah didapat semua nilai yang dibutuhkan, pergi ke sheet
> Rekap PPh 23
> Sheets("rekap pph 23").Select
>
> ' pergi ke cell b3 yang merupakan header dari nomer seri
> transaksi
> Range("b3").
>
> ' lakukan pengujian terhadap 1 cell di bawah cell b3
> ' jika tidak ada datanya maka turun 1 baris ke cell b4
> ' jika ada datanya maka pergi ke baris terakhir yang ada datanya
> ' lalu turun lagi 1 baris ke baris baru yang kosong
>
> ' bahasa manusianya:
> ' jika 1 baris di bawah cell aktif tidak ada datanya, maka
> If ActiveCell.Offset(
>
> ' turun 1 baris ke bawah
> ActiveCell.Offset(
>
> ' karena ini adalah data pertama, maka beri nomer 1 pada 1
> kolom di sebelah kiri
> ActiveCell.Offset(
>
> ' selain itu
> Else
>
> ' berarti 1 baris di bawahnya ada datanya
> ' turun ke baris terakhir yang ada datanya dengan perintah
> .End(xlDown)
> ' lalu turun 1 baris lagi ke bawah yang kosong dengan
> perintah .Offset(1, 0)
> ActiveCell.End(
>
> ' karena ini bukan data pertama, maka beri nomor pada 1
> kolom di sebelah kiri
> ' nilainya berasal dari 1 baris di atasnya & 1 kolom di
> sebelah kiri (kiri atas)
> ActiveCell.Offset(
> -1).Value + 1
>
> ' akhir dari pengecekan data di bawah header
> End If
>
> ' masukkan nilai dari setiap variabel ke tempatnya masing-masing
> ActiveCell.Value = NoTrsk
> ActiveCell.Offset(
> ActiveCell.Offset(
> ActiveCell.Offset(
> ActiveCell.Offset(
> ActiveCell.Offset(
> ActiveCell.Offset(
> ActiveCell.Offset(
> ActiveCell.Offset(
>
> ' setelah itu kembali lagi ke sheet Form Isi 2 untuk mengambil
> data berikutnya
> Sheets("form isi 2").Select
>
> ' akhir dari penegcekan DPP
> End If
>
> ' lakukan untuk cDPP berikutnya
> Next cDPP
>
> ' aktifkan lagi menu screen update
> Application.
> End Sub
>
> Cara memanggilnya dengan cara menekan sebuah shape yang sudah di-assign
> dengan macro
>
> untuk formula yang ditanyakan silakan dilihat langsung pada file terlampir
>
> semoga bermanfaat,
>
> Best Regard,
>
> -Ms. Jan Raisin-
>
> 2012/12/4 <hartini_80@
>
> > **
> >
> >
> > ** Dear miss jan,
> > Berikut saya kirimkan rekap yang diinginkan, untuk N23 dia mengacu ke
> > sheet tarif, jika memiliki NPWP (cell I7 terisi) maka ditarif yg digunakan
> > itu 2%, jika tidak memiliki npwp 4%
> > Jika tidak menggunakan rekam macro bagaimana carax ya?
> > Mohon bantuannya
> >
> > Salam
> > Tiny
> > Powered by Telkomsel BlackBerry®
> > ------------
> > *From: * Jan Raisin <miss.jan.raisin@
> > *Sender: * belajar-excel@
> > *Date: *Tue, 4 Dec 2012 12:50:38 +0700
> > *To: *<belajar-excel@
> > *ReplyTo: * belajar-excel@
> > *Subject: *Re: [belajar-excel] Fw: Emailing: rekam macro transpose
> >
> >
> >
> > Dear mbak Tini,
> >
> > 1. sebelumnya bisakah dibantu dengan beberapa baris data yang diinginkan
> > di sheet rekap pph 23, karena tidak semua member millis bekerja di bidang
> > yang sama dengan mbak Tini.
> >
> > 2. untuk isian di sheet Form Isi 2 cell N23, yang dimaksud kolom 17 itu
> > cell yang mana ya?
> >
> > maaf, bertanya tanpa urun solusi :D
> >
> > Best Regard,
> >
> > -Ms. Jan Raisin-
> > *kelihatannya untuk kasus ini teknik rekam macro akan lebih sulit
> > dibandingkan dengan menulis script langsung di VBE*
> >
> > 2012/12/4 <hartini_80@
> >
> >> **
> >>
> >>
> >> Dear all
> >> Adakah yg bisa mengajakan kepada saya, bagaimana proses rekam makro untuk
> >> transpose
> >> Terima kasih
> >> Salam
> >> Tiny
> >>
> >> Powered by Telkomsel BlackBerry®
> >>
> >> -----Original Message-----
> >> From: Hartini FIN <hartini.fin@
> >> Date: Tue, 4 Dec 2012 04:28:07
> >> To: hartini_80@.
> >> Subject: Emailing: rekam macro transpose
> >>
> >>
> >> Your message is ready to be sent with the following file or link
> >> attachments:
> >>
> >> rekam macro transpose
> >>
> >>
> >> Note: To protect against computer viruses, e-mail programs may prevent
> >> sending or receiving certain types of file attachments. Check your e-mail
> >> security settings to determine how attachments are handled.
> >> CONFIDENTIAL NOTE: The information contained in this email is intended
> >> only for the use of the individual or entity named above and may contain
> >> information that is privileged, confidential and exempt from disclosure
> >> under applicable law. If the reader of this message is not the intended
> >> recipient, you are hereby notified that any dissemination, distribution or
> >> copying of this communication is strictly prohibited. If you have received
> >> this message in error, please immediately notify the sender and delete the
> >> mail. Thank you.
> >>
> >>
> >
> >
>
GROUP FOOTER MESSAGE
---------------------------------------------------------------------
bergabung ke milis (subscribe), kirim mail kosong ke:
belajar-excel-subscribe@yahoogroups.com
posting ke milis, kirimkan ke:
belajar-excel@yahoogroups.com
berkunjung ke web milis
http://tech.groups.yahoo.com/group/belajar-excel/messages
melihat file archive / mendownload lampiran
http://www.mail-archive.com/belajar-excel@yahoogroups.com/
atau (sejak 25-Apr-2011) bisa juga di :
http://milis-belajar-excel.1048464.n5.nabble.com/
menghubungi moderators & owners: belajar-excel-owner@yahoogroups.com
keluar dari membership milis (UnSubscribe):
kirim mail kosong ke belajar-excel-unsubscribe@yahoogroups.com
---------------------------------------------------------------------
bergabung ke milis (subscribe), kirim mail kosong ke:
belajar-excel-subscribe@yahoogroups.com
posting ke milis, kirimkan ke:
belajar-excel@yahoogroups.com
berkunjung ke web milis
http://tech.groups.yahoo.com/group/belajar-excel/messages
melihat file archive / mendownload lampiran
http://www.mail-archive.com/belajar-excel@yahoogroups.com/
atau (sejak 25-Apr-2011) bisa juga di :
http://milis-belajar-excel.1048464.n5.nabble.com/
menghubungi moderators & owners: belajar-excel-owner@yahoogroups.com
keluar dari membership milis (UnSubscribe):
kirim mail kosong ke belajar-excel-unsubscribe@yahoogroups.com
---------------------------------------------------------------------
Tidak ada komentar:
Posting Komentar