Excel VBA質問箱 IV

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

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


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

【37905】複数行参照してセルをコピーしていくんですが・・・ せりかっち 06/5/22(月) 23:26 質問[未読]
【37907】Re:複数行参照してセルをコピーしていくん... Kein 06/5/23(火) 0:24 回答[未読]
【37908】Re:複数行参照してセルをコピーしていくん... ponpon 06/5/23(火) 0:58 発言[未読]
【37935】Re:複数行参照してセルをコピーしていくん... せりかっち 06/5/23(火) 19:03 お礼[未読]

【37905】複数行参照してセルをコピーしていくんで...
質問  せりかっち  - 06/5/22(月) 23:26 -

引用なし
パスワード
   複数行のデータを参照して、該当するデータの別行の値をコピペしたいんですが・・・

Sheet1に次のようなデータが入っています。


データが入っているのは、15行目からです。


A列    B列   C列   D列   E列   ・・・・・
----------------------------------------------------------------------
種別    A     内    A    A    ・・・・・
名前   せりか  ゆき   せりか せりか1 ・・・・
区別   1    2    2   1   ・・・・
機種名  AZ1   AZ2   AZ24   AZ90  ・・・・・

5行あけて、

種別   内    内    A      A    ・・・・・
名前   せりか  せりか せりか  せりか1 ・・・・
区別   1    1   1     1   ・・・・
機種名  AZ13   AZ42   AZ8    AA2  ・・・・・

また5行あけて、

種別   A     A    A     内    ・・・・・
名前   せりか  せりか  せりか  せりか1 ・・・・
区別   2    1    2    1   ・・・・
機種名  AZ11   AZ5    AA20    AA6  ・・・・・


と、決まった行数おきに4行のデータが3つぶん入力してあります。
"種別"の行を1つめのデータから3つぶん参照していって
"内"の場合は、"機種名"のセルをコピーしてセルB2へ順に右へ貼り付け、12列(M列まで)入ったらB3(1つ下の行へ)同じようにコピーしていく処理を、データが無くなるまで繰り返すにはどうしたらいいんでしょうか??

結果

A列    B列   C列   D列   E列  ・・・・M列
----------------------------------------------------------------------
     AZ2   AZ13   AZ42   AA6       ←ここで改行
     AZ89   AZ66・・・・・・・・・       ←ここで改行
貼り付けるデータが無くなるまで、繰り返す


IF文を使うのかな?くらいしかわかりません;;
説明が難しいのですが・・・よろしくお願い致します。                 

【37907】Re:複数行参照してセルをコピーしていく...
回答  Kein  - 06/5/23(火) 0:24 -

引用なし
パスワード
   こんな感じです。

Sub Data_Serach()
  Dim FR As Range
  Dim i As Long, j As Long
  Dim Ad As String
 
  Set FR = Range("A15:IV33").Find("内", _
  , xlValues, xlWhole, , xlPrevious)
  If FR Is Nothing Then Exit Sub
  Ad = FR.Address: i = 2: j = 2
  Do
   Set FR = Range("A15:IV33").FindNext(FR)
   Cells(i, j).Value = FR.Offset(3).Value
   j = j + 1
   If j = 14 Then
     i = i + 1: j = 2
   End If
  Loop Until FR.Address = Ad
  Set FR = Nothing
End Sub

【37908】Re:複数行参照してセルをコピーしていく...
発言  ponpon  - 06/5/23(火) 0:58 -

引用なし
パスワード
   すでに、Keinさんから回答があるので、おこがましいのですが、
一応作ってみたので、黙々とループさせています。
こういうことでしょうか?書き出しは、Sheet1でいいのですよね?

Sub test()
  Dim i As Long, j As Long, t As Long
  Dim p As Long, m As Long
 
  Application.ScreenUpdating = False
  Sheets("Sheet2").Cells.ClearContents
  With Sheets("Sheet1")
    j = 1: p = 1: m = 1
    Do
     For i = 15 To 34 Step 9
       For t = 1 To 3
        If .Cells(i, j + t).Value = "内" Then
          .Cells(i, j + t).Offset(3).Copy
           .Cells(m, p + 1).PasteSpecial
          p = p + 1
         If p > 12 Then m = m + 1: p = 1
        End If
       Next
     Next
     i = 15
     j = j + 3
     If .Cells(i, j + t).Value = "" Then Exit Do
    Loop
  End With
  With Application
    .ScreenUpdating = True
    .CutCopyMode = False
  End With
End Sub

【37935】Re:複数行参照してセルをコピーしていく...
お礼  せりかっち  - 06/5/23(火) 19:03 -

引用なし
パスワード
   レス遅くなってしまい申し訳ありません。
さっそくやってみます!!
keinさん、ponponさん、ありがとうございました♪♪m(__)m

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