検索
2013年05月18日
【VBA】正規表現で検索
≪正規表現で検索≫
≪Null or Emptyのチェック≫・・・・おまけ
≪searchWithRegularExpression()の呼び出し≫
続きを読む
' 正規表現で検索
' ※検索元と検索KyeのどちらかNull or Emptyの場合は見つからなかったこととする
' @param str 検索元
' @param searchwd 検索Kye
' @return 検索Kyeにマッチする文字列が見つかったらTrue、見つからない場合はFalseを返す
Private Function searchWithRegularExpression(str As String, searchwd As Variant) As Boolean
' 正規表現用オブジェクト
Dim reg As Object
searchWithRegularExpression = False
Set reg = CreateObject("VBScript.RegExp") 'オブジェクト作成
'正規表現オブジェクトの設定
With reg
.Pattern = searchwd 'パターンを設定
.IgnoreCase = True '大文字と小文字を区別するFalseか、しないTrueか
.Global = True '文字列全体を検索するTrueか、しないFalseか
End With
' 検索元と検索KyeのどちらもNull or Emptyでない場合
If Not (isNullOrEmpty(str) Or isNullOrEmpty(searchwd)) Then
' 検索結果
searchWithRegularExpression = reg.Test(str)
End If
End Function
≪Null or Emptyのチェック≫・・・・おまけ
' Null or Emptyのチェック
' @param str チェック対象
' @return 対象がNull or Emptyの場合True、そうでなければFalseを返す
Private Function isNullOrEmpty(var As Variant) As Boolean
isNullOrEmpty = False
' Null or Empty の場合
If IsNull(var) Or IsEmpty(var) Then
isNullOrEmpty = True
End If
End Function
≪searchWithRegularExpression()の呼び出し≫
Sub Sample()
Const str = "abcDEFgHi Jk" ' 検索元
Dim colSearchwds As New Collection ' 検索KyeのCollection
Dim var As Variant ' 作業用
colSearchwds.Add "ghi"
colSearchwds.Add "^(ABC)" ' 文字列の最初が"ABC"で始まる
colSearchwds.Add "(def|jk)$" ' 文字列の最後が"def"か"jk"で終わる
' 検索
For Each var In colSearchwds
MsgBox var & " : " & searchWithRegularExpression(str, var)
Next
End Sub
続きを読む
2012年03月28日
【VBA】シート内のセル色検索
《セルの色を検索し、検索したセルの値が入ったCollectionを返す》
《searchColors()の呼び出し》
続きを読む
Private Function searchColors(sh As Worksheet, intColor As Integer)
Dim Rng As range
Dim f As String
Dim col As New Collection
' 何も検索されなかった場合の戻り値をセット
Set searchColors = col
' カラーをセット
Application.FindFormat.Interior.ColorIndex = intColor
' セットしたカラーのセルを検索
Set Rng = sh.Cells.Find(What:="", SearchFormat:=True)
' 検索で何もヒットしなかったら、searchColors()を終了させる
If Rng Is Nothing Then Exit Function
' 最初に検索されたセルのアドレスを保持する
f = Rng.Address
Do
' 検索された値をCollectionに追加
col.Add (Rng.Value)
' 次に検索されたセルを保持する
Set Rng = sh.Cells.Find(What:="", After:=Rng, SearchFormat:=True)
' 検索されたセルが最初に検索されたセルと同じアドレスだったら、ループを抜ける
If Rng.Address = f Then Exit Do
Loop
' 戻り値(検索された値のCollection)をセット
Set searchColors = col
End Function
《searchColors()の呼び出し》
Sub sample()
Dim book As Workbook
Dim sh As Worksheet
Dim col As Collection
Dim i As Integer
' 使いたいブックをオープン
Set book = Workbooks.Open(ThisWorkbook.Path & "\from.xls")
' 使いたいシートを指定
Set sh = book.Worksheets(1)
' 色を検索し、結果をCollectionに入れる
Set col = searchColors(sh, 34)
' ちゃんと入っているか確認
If col.Count = 0 Then
MsgBox "なにもヒットしませんでした。"
Else
For i = 1 To col.Count
MsgBox col(i)
Next i
End If
End Sub
続きを読む