Terima kasih Pak Dwint atas formula Evaluatenya.
Namun setelah angka 20 saya ganti dengan 19 dan kolom J saya ganti dengan B, No. NPB nya "-1" semua, sedangkan yang diharapkan ada "-1", "-2" dan "-3" pada No. NPB 9953 dan 9955.

Salam,
HK


From: dwint ruswanto <[email protected]>
To: [email protected]
Sent: Monday, 9 September 2013, 10:39
Subject: Re: [belajar-excel] rumus yang tidak running

 
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










Kirim email ke