Excel VBA質問箱 IV

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

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


64442 / 76732 ←次へ | 前へ→

【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

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 お礼

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