Excel VBA質問箱 IV

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

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


64447 / 76738 ←次へ | 前へ→

【16872】Re:文字列の比較、置換
お礼  Muro  - 04/8/13(金) 10:22 -

引用なし
パスワード
   ▼Hirofumi さん:
>こんな物かな?
>
>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

ありがとうございます。
おかげさまで解決いたしました。
0 hits

【16870】文字列の比較、置換 KAME 04/8/13(金) 2:17 質問
【16871】Re:文字列の比較、置換 Hirofumi 04/8/13(金) 6:26 回答
【16872】Re:文字列の比較、置換 Muro 04/8/13(金) 10:22 お礼

64447 / 76738 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free