Excel VBA質問箱 IV

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

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

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
7616 / 13646 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【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　　　　・・・・・
名前　　 せりか　　ゆき　　 せりか　せりか１　・・・・
区別　　　１　　　 ２　　　　２　　　１　　　・・・・
機種名　　AZ1　　　AZ2　　　AZ24　　 AZ90　　・・・・・

５行あけて、

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

また５行あけて、

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


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

結果

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
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
7616 / 13646 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free