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 <ngademi...@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
>
>
> ------------------------------
> **
>
>
