| |
はじめまして、よろしくお願いします。
表題の通り、for文で、条件に当てはまらないときは、exitで抜けるのではなく、次の処理を行うというコードがかけなくて困っています。
sheet3のデータ：
項目 ＿1＿2＿3
あああ｜ 2 15 30
いいい｜10 8 9
あああ｜ 5 30 5
あああ｜ 6 7 8
あああ｜12 7 15
えええ｜10 5 6
あああ｜ 7 8 9
ううう｜15 5 5
えええ｜10 5 6
という表からオートフィルター"あああ"で抽出して、以下のようにしたい
sheet2:
あああ あああ 一 あああ あああ 一 あああ
2 5 列 6 12 列 7
15 30 空 7 7 空 8
30 5 8 15 9
コードは次の通りです。
Sub fortest()
Dim start As Integer
Dim last As Long
Dim t As Integer
Sheets("Sheet3").Activate
With Worksheets("Sheet3")
.Range("A4").AutoFilter Field:=1, Criteria1:="あああ"
With .AutoFilter.Range
start = .Offset(1).SpecialCells(xlCellTypeVisible).Row
End With
End With
last = Cells(Rows.Count, 1).End(xlUp).Row
For t = start To last
Worksheets("Sheet3").Select
Range("A" & t).Select
Range(Selection, Selection.Offset(0, 3)).Select
Selection.Copy
'オートフィルターで抽出した行を一行ずつ選んでいきます。
Sheets("あああ").Activate
ActiveSheet.Range("A1").Select
Selection.Offset(, t - start).Select
'オートフィルターで抽出した行数分右にコピーしていきます。
If ActiveCell.Column Mod 3 <> 0 Then
Else:
Selection.Offset(, 1).Select
'だけど、貼り付け先の列が3の倍数だったらそこは飛ばしてくださいね。
End If
ActiveCell.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Next t
Worksheets("Sheet3").Select
Selection.AutoFilter
End Sub
というような感じです。ですがこのコードですと、
一列飛ばしたあとの列にはその次の抽出行が上から貼り付けられてしまいます。（当たり前ですよね）
それを解消するにはどうすればいいか教えていただけると幸いです。
|
|
チューリップ
- 09/7/2(木) 13:29 -
