izin pinjam script dari Miss Jan dan modifikasi sedikit ya.. script awal:
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(, 20).Value = cel.Value & "-" & iCount
Next cel
script hasil modifikasi:
Dim rgNpb As Range, cel As Range
Dim lRow As Long
lRow = Cells(Rows.Count, 2).End(xlUp).Row
Set rgNpb = Range(Cells(6, 2), Cells(lRow, 2))
For Each cel In rgNpb
cel.Offset(, 20).Value = cel.Value & "-" &
Evaluate("=COUNTIF(J$6:J6,J6)")
Next cel
yang diwarnai merah adalah script asli yang dihilangkan
yang warna biru dalam blok hijau adalah script pengganti
btw, foto profilenya Miss Jan yang baru keren [?]
Wassalam,
-dwint-
Pada 8 September 2013 11.52, hendrik karnadi <[email protected]>menulis:
> **
>
>
> Pak Dwint,
> Jika iCount = Application.WorksheetFunction.CountIf(rgCount, cel.Value)
> diganti
> dengan iCount = Evaluate("=CountIf(rgCount, cel.Value") maka ketika macro
> dijalankan akan timbul error "Type mismatch".
>
> Salam,
> HK
>
> ------------------------------
> *From:* dwint ruswanto <[email protected]>
> *To:* [email protected]
> *Sent:* Sunday, 8 September 2013, 5:34
>
> *Subject:* Re: [belajar-excel] rumus yang tidak running
>
>
> mungkin seperti ini
> Cells("alamat_celnya").Value = Evaluate("=formulanya")
> jadi script yang berbunyi
> Application.WorksheetFuntion.Formulanya(blablabla)
> langsung diganti dengan Evaluate
> secara logika script tersebut akan berjalan lebih cepat karena:
> memangkas waktu yang digunakan untuk memanggil formula di worksheet untuk
> diaplikasikan ke dalam vba, karena prosesnya langsung digantikan oleh
> fungsi internal vba itu sendiri
> kira2 seperti itu.. untuk pembuktian mungkin dapat diuji kecepatan proses
> dengan beberapa baris data yabg lebih banyak.
> maaf jika penjelasannya berantakan, karena diketik menggunakan handphone.
> cmiiw.
> -dwint-
> On Sep 7, 2013 10:17 PM, "hendrik karnadi" <[email protected]>
> wrote:
>
> **
>
> Btw, gimana codenya Mr. Kid karena saya belum kenal baik dengan teman
> kita yang bernama "Evaluate".
>
> Salam,
> HK
>
> ------------------------------
> *From:* Mr. Kid <[email protected]>
> *To:* BeExcel <[email protected]>
> *Sent:* Saturday, 7 September 2013, 19:10
> *Subject:* Re: [belajar-excel] rumus yang tidak running
>
>
> 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
>
>
>
>
>
>
>
>
>
<<328.png>>
