maaf.. koreksi sedikit
Dim rgNpb As Range, cel As Range
Dim lRow As Long, lCel As Long
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
cel.Offset(, 20).Value = cel.Value & "-" & Evaluate("=COUNTIF(B$6:B"
& lCel & ",B" & lCel & ")")
Next cel
tadi salah ambil kolom.. seharusnya dari kolom B tetapi salah ambil menjadi
kolom J
yang warna hijau adalah script yang dimunculkan kembali
yang warna biru dalam blok hijau adalah cara penggunaan Evaluate-nya
Wassalam,
-dwint-
Pada 9 September 2013 10.39, dwint ruswanto <[email protected]>menulis:
> 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>>
