Kalau pakai loop, coba pakai Evaluate daripada worksheetfunction. Sapa tahu bisa lebih cepat.
Wassalam, Kid. On Sat, Sep 7, 2013 at 4:54 PM, hendrik karnadi <[email protected]>wrote: > ** > > > Mumpung lagi senggang dan Mr Kid. baru saja membahas looping dengan > For....., dengan meminjam codes dari MJR (boleh kan Miss?), > maka saya coba mainkan dengan Event Worksheet_Change pada sel U5 tempat > dimana No. NPB, No. PR dan No. PO mau diletakkan. > > Codes pada VBE Sheet3(tabel): > Option Explicit > > Private Sub Worksheet_Change(ByVal Target As Range) > If Target.Address = "$U$5" Then > If Target.Count = 1 Then > With Target > If .Value = "No. NPB" Then > Call NPB > ElseIf .Value = "No. PR" Then > Call PR > ElseIf .Value = "No. PO" Then > Call PO > > End If > End With > End If > End If > End Sub > > Codes pada Module1 (setelah insert module): > Option Explicit > > Sub NPB() > Dim rgNpb As Range, cel As Range, rgCount As Range > Dim lRow As Long, lCel As Long > Dim iCount As Integer > > lRow = Cells(Rows.Count, 2).End(xlUp).Row > Set rgNpb = Range(Cells(6, 2), Cells(lRow, 2)) > For Each cel In rgNpb > lCel = cel.Row > Set rgCount = Range(Cells(6, 2), Cells(lCel, 2)) > iCount = Application.WorksheetFunction.CountIf(rgCount, cel.Value) > cel.Offset(, 19).Value = cel.Value & "-" & iCount '20 diganti 19 > (sebelumnya > tertulis 20) > Next cel > End Sub > > Sub PR() > Dim rgPR As Range, cel As Range, rgCount As Range > Dim lRow As Long, lCel As Long > Dim iCount As Integer > > lRow = Cells(Rows.Count, 10).End(xlUp).Row '2 diganti 10 > Set rgPR = Range(Cells(6, 10), Cells(lRow, 10)) '2 diganti 10 > For Each cel In rgPR > lCel = cel.Row > Set rgCount = Range(Cells(6, 10), Cells(lCel, 10)) '2 diganti 10 > iCount = Application.WorksheetFunction.CountIf(rgCount, cel.Value) > cel.Offset(, 11).Value = cel.Value & "-" & iCount '19 diganti 11 > Next cel > End Sub > > Sub PO() > Dim rgPO As Range, cel As Range, rgCount As Range > Dim lRow As Long, lCel As Long > Dim iCount As Integer > > lRow = Cells(Rows.Count, 16).End(xlUp).Row '2 diganti 16 > Set rgPO = Range(Cells(6, 16), Cells(lRow, 16)) '2 diganti 16 > For Each cel In rgPO > lCel = cel.Row > Set rgCount = Range(Cells(6, 16), Cells(lCel, 16)) '2 diganti 16 > iCount = Application.WorksheetFunction.CountIf(rgCount, cel.Value) > cel.Offset(, 5).Value = cel.Value & "-" & iCount '19 diganti 5 > Next cel > End Sub > > Semoga bermanfaat (pinjam slogan pak Anton). > > Salam, > HK > > File dilampirkan untuk uji materi > > ------------------------------ > *From:* neza ibaneza <[email protected]> > *To:* "[email protected]" <[email protected]> > *Sent:* Friday, 6 September 2013, 7:19 > *Subject:* [belajar-excel] rumus yang tidak running > > > Salam B-Excel > > Master-master yang baik hati, saya coba buat rumus VBA, tp kok ada > sebagian yang tidak running > masalahnya dimana ya? > > Salam > Neza > > > >
