FIND DAN REPLACE text atau
string dalam excel worksheet atau range adalah hal biasa dan mudah dilakukan
dengan perintah Find (Ctrl + F) atau
Replace (Ctr + H). Namun bagaimana caranya menemukan dan menukar text dalam exel
comment. Saya belum menemukan cara lain selain menggunakan
vba dan macro. Contoh script berikut
dapat digunakan untuk mencari dan sekaligus mengganti text tertentu dalam
comment box.
1.
Contoh Script untuk mencari dan menghitung text
tertentu yang dijumpai dalam text comment dan memberikan informasi hasil dari
proses tersebut.
'----------------------------------------------------------------------------------------
Sub findTextInComment()
Dim findStr As String, cmtStr
As String, r As Range
Dim i As Long, findCount As
Long, cmtCount As Long
findStr = InputBox("Text
Yang Dicari :")
If findStr = "" Then
Exit Sub
For Each r In Selection
If Not (r.Comment Is Nothing) Then
cmtCount = cmtCount + 1
cmtStr = r.Comment.Text
i = InStr(1, cmtStr, findStr,
vbTextCompare)
Do While i <> 0
findCount = findCount + 1
i = InStr(i + 1, cmtStr, findStr,
vbTextCompare)
r.Interior.Color = vbGreen
Loop
End If
Next
MsgBox "Hasil Pencarian
: " & findCount
End Sub
2.
Contoh Scrip untuk mengganti text tertentu yang
dijumpai dalam text comment, dan memberikan informasi hasil dari proses
tersebut:
Nb: pada script lainnya yang saya jumpai dari berbagai sumber di internet,
biasanya proses replace text comment merubah/merusak format sebelumnya. Code vba excel macro berikut sudah di-test dan bekerja tanpa
merubah format comment text sebelumnya.
'----------------------------------------------------------------------------------------
Sub replaceTextInComment()
Dim c As Comment, r As Range, i
As Long, j As Long, k As Long
Dim sCmt As String, sFind As
String, sReplace As String
Dim replaceCount As Long,
cmtFindCount As Long, cmtCount As Long
Application.ScreenUpdating =
False
sFind = InputBox("text
yang akan ditukar :")
If sFind = "" Then
Exit Sub
sReplace = InputBox("text
pengganti :")
j = Len(sFind)
k = Len(sReplace)
For Each r In Selection
If Not (r.Comment Is Nothing)
Then
cmtCount = cmtCount + 1
Set c = r.Comment
i = InStr(1, c.Text, sFind, vbTextCompare)
If i > 0 Then
cmtFindCount = cmtFindCount + 1
r.Interior.Color = vbBlue
End If
Do While i > 0
If sReplace = "" Or i = 1
Then
c.Shape.TextFrame.Characters(i,
j).Insert (sReplace)
Else
sCmt = c.Text(sReplace, i + 1, j -
1)
c.Shape.TextFrame.Characters(i,
1).Insert ("")
End If
replaceCount = replaceCount + 1
i = InStr(i + k, c.Text, sFind,
vbTextCompare)
Loop
End If
Next
If replaceCount > 0 Then
Application.ScreenUpdating =
True
MsgBox ("BERHASIL DENGAN
KETERANGAN SBB: " & Chr(10) _
& "Text Awal: " &
Chr(34) & sFind & Chr(34) & Chr(10) _
& "Text Pengganti: " &
Chr(34) & sReplace & Chr(34) & Chr(10) _
& "Text Diganti: " & replaceCount & Chr(10) _
& "Comment dicek: " &
cmtCount & Chr(10) _
& "Comment diganti: " &
cmtFindCount)
End If
End Sub
Cara menggunakan macro: sorot range yang ada insert comment-nya dan kemudian jalankan makro di atas.
Bkn main
ReplyDeleteMantap min membuat daftar isi otomatis di word
ReplyDelete