Excel VBA質問箱 IV

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

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


9147 / 13644 ツリー ←次へ | 前へ→

【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 お礼[未読]

【29025】商品CDを参照してコピーの方法
質問  りょうた  - 05/9/21(水) 21:46 -

引用なし
パスワード
   こんにちは。
色々と試しているのですが、うまくいかず、なんか頭がこんがらがったので
どなたか、教えていただけないでしょうか?

★商品CDを参照して同じならば数量を貼り付ける★

例・・・※1の商品CDと※2の商品CDが一致した場合、その商品CDの※1の数量を
※2のG列に貼り付ける。
(※1・※2には、重複CDはありません)

※1・・・コピーしたいデータ
W138から、下方向に商品CDがあります。(場合によってデータ数は異なります)
その右隣のセル(W139から下方向)に数量があります。

※2・・・貼り付けたい表
B3,B6・・・B90のように2行飛ばしで商品CDがあります。
B91,B92,B93と、最後に4つ(B90から数えて)行は飛ばさずに、商品CDがあります。
数量は、B列から右方向に5列ずれたG3,G6・・・G90,G91.G92,G93に、貼り付けたいのです。

※1の検索範囲は
Dim r As Range
Dim z As Long
Z = Range("W138").End(xldown).Row
Set r = Rang("W138:W" & z)

※2の検索は
Dim n As Long,i As Long,ni As Long
For n = 3 To 87 Step 3
For i = 90 To 93
For ni = n TO i

Cells(ni,2)

でよいのかな?と思ったのですが、よいでしょうか?

また、FINDメゾットを使ってみたのですが、いまいちうまくいきません
まずいのでしょうか?
どなたか、アドバイスいただけませんか?

【29033】Re:商品CDを参照してコピーの方法
回答  awu  - 05/9/22(木) 0:37 -

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


Sub 検索値貼付()
Dim Rng As Range
Dim FRng As Range
Dim Rw As Long
For Rw = 3 To 87 Step 3
  Set Rng = Range("B" & Rw)
  Set FRng = Range("W138", Range("W65536").End(xlUp)). _
          Find(Rng.Value, lookat:=xlWhole)
  If Not FRng Is Nothing Then
    Rng.Offset(, 5).Value = FRng.Offset(, 1).Value
  End If
Next Rw
For Rw = 90 To 93
  Set Rng = Range("B" & Rw)
  Set FRng = Range("W138", Range("W65536").End(xlUp)). _
        Find(Rng.Value, lookat:=xlWhole)
  If Not FRng Is Nothing Then
    Rng.Offset(, 5).Value = FRng.Offset(, 1).Value
  End If
Next Rw
Set Rng = Nothing: Set FRng = Nothing
End Sub

【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

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

【29072】Re:続けて質問ですが、オフセット位置の...
回答  Hirofumi  - 05/9/23(金) 0:42 -

引用なし
パスワード
   変数bookと変数Noの関係に注目して見たら?

  book = Range("W137").Value
  Select Case book
    Case "01"
      No = 5
    Case "02"
      No = 6
    Case "03"
      No = 7
      ・
      ・
    Case "29"
      No = 33
    Case "30"
      No = 34
    Case Else
      Exit Sub
  End Select

もし、変数bookの値が数値なら("01"→1、"02"→2)、
其の数値+4が変数Noの値に成れば善いのでは?
VBAで、文字列を数値に評価する関数は、Val関数、Clng関数等が有ります
Val関数は、空白の文字列、スペースの文字列、数字以外の文字列の場合
0を返すので、この様な場合エラー処理をしなくても善い可能性が有るので
Val関数を使うと善いでしょう?
また、変数bookの範囲は、"01"〜"30"なのでそれ以外の場合、Subを抜けます

それをコードで表すと、以下の様に成ります
Sub 検索値貼付()
  
  Dim rng1 As Range
  Dim rng2 As Range
  Dim n As Long
  Dim z As Long
'  Dim book As String
  Dim book As Long
  Dim No As String
  
  book = Val(Range("W137").Value)
  If 1 <= book And book <= 30 Then
    No = book + 4
  Else
    Exit Sub
  End If
  
  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

【29090】Re:続けて質問ですが、オフセット位置の...
お礼  りょうた  - 05/9/23(金) 20:35 -

引用なし
パスワード
   ▼Hirofumi さん:

ご回答ありがとうございます。

>もし、変数bookの値が数値なら("01"→1、"02"→2)、
>其の数値+4が変数Noの値に成れば善いのでは?
>VBAで、文字列を数値に評価する関数は、Val関数、Clng関数等が有ります
>Val関数は、空白の文字列、スペースの文字列、数字以外の文字列の場合
>0を返すので、この様な場合エラー処理をしなくても善い可能性が有るので
>Val関数を使うと善いでしょう?
>また、変数bookの範囲は、"01"〜"30"なのでそれ以外の場合、Subを抜けます

>  book = Val(Range("W137").Value)
>  If 1 <= book And book <= 30 Then
>    No = book + 4
>  Else
>    Exit Sub
>  End If

Val関数は、目から鱗が落ちる思いで感動です。
おかげですっきりした内容になりました。
実際には、01,02の様に数字だけではないのですが
セルにVLOOK関数を使用して、01,02の様に値が返る様にして
仕上げました。
応用すれば、うまくできるものなんですね。
ありがとうございました。
また、煮詰まりましたら、投稿すると思いますので
その際は、よろしくお願いいたします。

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