Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

64517 / 76807

←次へ　｜　前へ→


	【16871】Re:文字列の比較、置換

Hirofumi - 04/8/13(金) 6:26 -


	引用なし

	パスワード

こんな物かな？

Option Explicit

Public Sub Sample()

　　Dim i As Long
　　Dim j As Long
　　Dim rngTop As Range
　　Dim vntResult As Variant
　　Dim rngList As Range
　　
　　'座標の有る表の左上隅の位置を設定
　　Set rngTop = Worksheets("Sheet1").Cells(1, "A")
　　'座標の有る表を配列に取得
　　vntResult = rngTop.CurrentRegion.Value
　　
　　'置換する値の有るListの範囲を取得
　　With Worksheets("Sheet2")
　　　　Set rngList = Range(.Cells(1, "B"), _
　　　　　　　　　　　　　　.Cells(65536, "B").End(xlUp))
　　End With
　　
　　'座標の有る表の値を置換
　　For i = 1 To UBound(vntResult, 1)
　　　　For j = 1 To UBound(vntResult, 2)
　　　　　　vntResult(i, j) _
　　　　　　　　= RowSearch(vntResult(i, j), rngList)
　　　　Next j
　　Next i
　　
　　'座標の有る表を書き戻す
　　With rngTop
　　　　.Resize(UBound(vntResult, 1), _
　　　　　　　　UBound(vntResult, 2)) = vntResult
　　End With
　　
　　Set rngList = Nothing
　　Set rngTop = Nothing
　　
　　Beep
　　MsgBox "処理が完了しました"
　　
End Sub

Private Function RowSearch(vntKey As Variant, _
　　　　　　　　　　　　rngScope As Range) As Variant
　　
'　一覧の探索

　　Dim vntFound As Variant
　　
　　'一覧を探索して行位置を取得
　　vntFound = Application.Match(vntKey, rngScope, 0)
　　'エラーで無い場合（一覧に値が有る）
　　If Not IsError(vntFound) Then
　　　　'取得行の探索列左の値を返す
　　　　RowSearch = rngScope(vntFound).Offset(, -1).Value
　　End If
　　
End Function

1 hits

▼

【16870】文字列の比較、置換 KAME 04/8/13(金) 2:17