- 日時： 2012/06/06 19:21
- 名前： VBレスキュー(花ちゃん)
- ***********************************************************************************
* カテゴリー：[エクセル][][] *
* キーワード：Excel VBA,Excel2010,連続検索,置き換え,文字色,見つかった位置,再検索 *
***********************************************************************************
'===================================================================================================
'投 稿 日：2012.05.06
'投 稿 者：VBレスキュー(花ちゃん)
'タイトル：VB2010 から Excel の選択範囲内で指定文字を連続検索
'========1=========2=========3=========4=========5=========6=========7=========8=========9=========0
Private Sub Button22_Click(sender As System.Object, e As System.EventArgs) Handles Button22.Click
Call ExcelOpen("", "") '新規ファイルをオープンして、Excel を起動
'====================== 選択範囲内で指定文字を連続検索 =======================
'-------------------- 下記のVB6.0用コードを移植 ---------------------------
' http://hanatyan.sakura.ne.jp/patio/read.cgi?mode=view2&f=128&no=24
'--------------------------------------------------------------------------
'仮データの入力
Dim xlRange As Excel.Range = Nothing
Dim retValue As Double = 0
'範囲を変えて試して見て下さい。(セル C3 を含む範囲内で)
For c As Integer = 1 To 5
For r As Integer = 1 To 6
xlRange = xlSheet.Range(R1ToA1(r, c), R1ToA1(r, c))
retValue += 1
Dim s1 As String = CStr(ChrW(65 + r + c)) & CStr(ChrW(70 + r + c))
xlRange.Value = s1 & " " & Str(retValue) & " " & s1
MRComObject(xlRange)
Next r
Next c
xlRange = xlSheet.Range("C3")
xlRange.Activate()
'指定のセル位置を含む空白行と空白列に囲まれた最小のセル範囲を取得
Dim xlCurrentRegion As Excel.Range
xlCurrentRegion = xlRange.CurrentRegion
xlCurrentRegion.Select()
'セル領域のアドレス(A1:E6)を取得しR1C1 形式のアドレス(1,1,6,5)に変換
'A1ToR1C1 関数の実使用例
Dim r1c1() As Integer = A1ToR1C1(xlCurrentRegion.Address( _
False, False, Excel.XlReferenceStyle.xlA1))
MRComObject(xlCurrentRegion)
MRComObject(xlRange)
'範囲の開始位置を整数で求める A1 → 1,1
Dim r1 As Integer = r1c1(0) '1 行
Dim C1 As Integer = r1c1(1) '1 列
'範囲の終了位置を整数で求める E6 → 6,5
Dim r2 As Integer = r1c1(2) '6 行
Dim C2 As Integer = r1c1(3) '5 列
Dim nCount As Integer = 0
Dim N As Integer = 0
Dim target As String = "GL"
Dim xlCharacters As Excel.Characters = Nothing
For c As Integer = C1 To C2 'C1 列 〜 C2 列までを調べる
For r As Integer = r1 To r2 'R1 行 〜 R2 行までを調べる
xlRange = xlSheet.Range(R1ToA1(r, c), R1ToA1(r, c))
Dim myText As String = xlRange.Value.ToString()
'該当セル内で見つかったら、セル内に複数存在するか調べる
N = InStr(1, myText, target)
While N <> 0
'見つかった文字列の位置
xlCharacters = xlRange.Characters(Start:=N, Length:=target.Length)
'見つかった文字列を赤色で太字で表示
Dim xlFont As Excel.Font
xlFont = xlCharacters.Font
With xlFont
.Color = Color.Red
.Bold = True
End With
MRComObject(xlFont)
MRComObject(xlCharacters)
nCount += 1 '見つかった文字列の個数をカウント
'見つかった位置から再度検索を繰り返す。
N = InStr(N + 1, myText, target)
End While
MRComObject(xlRange)
Next r
Next c
MessageBox.Show(Me, "[" & target & "]は、" & nCount.ToString() & " 回見つかりました。")
'=============================================================================
'Excelファイルを上書き保存(True 又省略すれば)して終了処理を実行
Call ExcelClose(IO.Path.GetFullPath(".\Test.xlsx"), False) 'False の場合保存しないで終了
'Excel.EXE がタスクマネージャに残っていないか調査(実使用時は必要なし)
Call ProcessCheck()
End Sub
|
VB2010 から Excel の選択範囲内で指定文字を連続検索(VB.NET)