Excel VBA質問箱 IV

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

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


5984 / 76733 ←次へ | 前へ→

【76353】Re:検索して置換
回答  γ  - 14/11/3(月) 22:34 -

引用なし
パスワード
   コメントを待っていましたが、
平日は時間がとれないので、準備しておいたものを示しておきます。
参考にしてください。

Sub test1() '例示されたケースだけに有効
  Dim r As Range
  Dim v As Variant

  For Each r In Range("A1", Range("A1").End(xlDown))
    v = r.Value
    Select Case v
    Case Cells(1, "B").Value
      v = Cells(1, "C").Value
    Case Cells(2, "B").Value
      v = Cells(2, "C").Value
    End Select
    r.Offset(0, 3).Value = v
  Next
End Sub

Sub test2() ' 一般的なケースに適用可能
  Dim r As Range
  Dim m As Variant

  For Each r In Range("A1", Range("A1").End(xlDown))
    m = Application.Match(r, Columns("B"))
    If Not IsError(m) Then
      r.Offset(0, 3).Value = Cells(m, "C").Value
    Else
      r.Offset(0, 3).Value = r.Value
    End If
  Next
End Sub

Sub test3() ' 一般的なケースに適用可能
  Dim dic As Object
  Dim r As Range

  Set dic = CreateObject("Scripting.Dictionary")

  For Each r In Range("B1", Range("B1").End(xlDown))
    dic(r.Value) = r.Offset(0, 1).Value
  Next

  For Each r In Range("A1", Range("A1").End(xlDown))
    If dic.exists(r.Value) Then
      r.Offset(0, 3).Value = dic(r.Value)
    Else
      r.Offset(0, 3).Value = r.Value
    End If
  Next
End Sub
1 hits

【76351】検索して置換 T氏 14/11/2(日) 23:40 質問[未読]
【76352】Re:検索して置換 γ 14/11/3(月) 7:08 発言[未読]
【76353】Re:検索して置換 γ 14/11/3(月) 22:34 回答[未読]
【76354】Re:検索して置換 T氏 14/11/4(火) 9:29 お礼[未読]
【76355】Re:検索して置換 γ 14/11/4(火) 22:06 発言[未読]

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