Excel VBA質問箱 IV

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

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


52516 / 76732 ←次へ | 前へ→

【29054】続けて質問ですが、オフセット位置の取得方法
お礼  りょうた  - 05/9/22(木) 16:44 -

引用なし
パスワード
   ▼awu さん:
>VBAを使わなくてもVLookUp関数等を使用した計算式で対応出来そうな
>内容ですが、VBAで処理すると、こんな感じで如何でしょうか。
>

ご回答ありがとうございます。
おかげさまで、以下の様に記して無事に解決いたしました。
変数は、当方の理解しやすい文字に変えてます。

Sub 検索値貼付()
Dim rng1 As Range
Dim rng2 As Range
Dim n As Long
Dim z As Long
z = Range("W138").End(xlDown).Row
For n = 3 To 87 Step 3
  Set rng1 = Range("B" & n)
  Set rng2 = Range("W138:W" & z).Find(rng1.Value, lookat:=xlWhole)
  If Not rng2 Is Nothing Then
    rng1.Offset(, 5).Value = rng2.Offset(, 1).Value
  End If
Next n
For n = 90 To 93
  Set rng1 = Range("B" & n)
  Set rng2 = Range("W138:W" & z).Find(rng1.Value, lookat:=xlWhole)
  If Not rng2 Is Nothing Then
    rng1.Offset(, 5).Value = rng2.Offset(, 1).Value
  End If
Next n
Set rng1 = Nothing: Set rng2 = Nothing
End Sub

続けて、質問なのですが、
実は、貼り付け位置(※2)であるG列"G3"〜"G93"の一つ上のセル"G2"に
見出し"01"が元々あるのですが、そのまま、右方向にセル"H2","I2","J2"・・・に
"02","03","04"・・・"30"まで見出しがあるのです。
(この見出しは、元のBOOK名です。(つまりブックが30個あってそこから貼り付けたいのです))

そこでコピーしたいデータ(※1)(いったんそれぞれのブックから貼り付けられた表)セル"W138"から下方向にある領域の見出しとしてセル"W137"にブック名"01"や"02"等が貼り付けられてるとした場合
そのセル"W137"の値を参照して、貼り付け位置(※2)のオフセット位置を取得したいのですが
その場合の方法は、どういう記述がBESTでしょうか?

一応、素人ながら、Select Caseで記述してうまく作動はしたのですが
セレクトケースが30通りもあり、とても長くなってしまいます。
以下に、記述しますので、もしも、簡潔に綺麗にまとめる記述方法が
ありましたら、教えて頂ければ幸いです。
よろしくお願いいたします。

Sub 検索値貼付()
Dim rng1 As Range
Dim rng2 As Range
Dim n As Long
Dim z As Long
Dim book As String
Dim No As String
book = Range("W137").Value
Select Case book
     Case "01"
      No = 5
     Case "02"
      No = 6
     Case "03"
      No = 7
     Case "04"
      No = 8
     Case "05"
      No = 9
     Case "06"
      No = 10
     Case "07"
      No = 11
     Case "08"
      No = 12
     Case "09"
      No = 13
     Case "10"
      No = 14
     Case "11"
      No = 15
     Case "12"
      No = 16
     Case "13"
      No = 17
     Case "14"
      No = 18
     Case "15"
      No = 19
     Case "16"
      No = 20
     Case "17"
      No = 21
     Case "18"
      No = 22
     Case "19"
      No = 23
     Case "20"
      No = 24
     Case "21"
      No = 25
     Case "22"
      No = 26
     Case "23"
      No = 27
     Case "24"
      No = 28
     Case "25"
      No = 29
     Case "26"
      No = 30
     Case "27"
      No = 31
     Case "28"
      No = 32
     Case "29"
      No = 33
     Case "30"
      No = 34
     Case Else    
     Exit Sub
    End Select
z = Range("W138").End(xlDown).Row
For n = 3 To 87 Step 3
  Set rng1 = Range("B" & n)
  Set rng2 = Range("W138:W" & z).Find(rng1.Value, lookat:=xlWhole)
  If Not rng2 Is Nothing Then
    rng1.Offset(, No).Value = rng2.Offset(, 1).Value
  End If
Next n
For n = 90 To 93
  Set rng1 = Range("B" & n)
  Set rng2 = Range("W138:W" & z).Find(rng1.Value, lookat:=xlWhole)
  If Not rng2 Is Nothing Then
    rng1.Offset(, No).Value = rng2.Offset(, 1).Value
  End If
Next n
Set rng1 = Nothing: Set rng2 = Nothing
End Sub

わかりにくいかもしれませんが、よろしくお願いいたします。

1 hits

【29025】商品CDを参照してコピーの方法 りょうた 05/9/21(水) 21:46 質問
【29033】Re:商品CDを参照してコピーの方法 awu 05/9/22(木) 0:37 回答
【29054】続けて質問ですが、オフセット位置の取得方... りょうた 05/9/22(木) 16:44 お礼
【29072】Re:続けて質問ですが、オフセット位置の取... Hirofumi 05/9/23(金) 0:42 回答
【29090】Re:続けて質問ですが、オフセット位置の取... りょうた 05/9/23(金) 20:35 お礼

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