Excel VBA質問箱 IV

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

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


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

【62220】Forで、条件に当てはまらない場合次の処理へ チューリップ 09/7/2(木) 13:29 質問[未読]
【62221】Re:Forで、条件に当てはまらない場合次の処... kanabun 09/7/2(木) 14:10 発言[未読]
【62222】Re:Forで、条件に当てはまらない場合次の処... チューリップ 09/7/2(木) 14:34 発言[未読]
【62224】Re:Forで、条件に当てはまらない場合次の処... つん 09/7/2(木) 14:46 発言[未読]
【62226】Re:Forで、条件に当てはまらない場合次の処... チューリップ 09/7/2(木) 15:27 お礼[未読]
【62223】Re:Forで、条件に当てはまらない場合次の処... SS 09/7/2(木) 14:37 発言[未読]
【62225】Re:Forで、条件に当てはまらない場合次の処... チューリップ 09/7/2(木) 14:54 お礼[未読]

【62220】Forで、条件に当てはまらない場合次の処...
質問  チューリップ  - 09/7/2(木) 13:29 -

引用なし
パスワード
   はじめまして、よろしくお願いします。

表題の通り、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

というような感じです。ですがこのコードですと、
一列飛ばしたあとの列にはその次の抽出行が上から貼り付けられてしまいます。(当たり前ですよね)
それを解消するにはどうすればいいか教えていただけると幸いです。

【62221】Re:Forで、条件に当てはまらない場合次の...
発言  kanabun  - 09/7/2(木) 14:10 -

引用なし
パスワード
   ▼チューリップ さん こんにちは

>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
>
>という表からオートフィルター"あああ"で抽出して、以下のようにしたい
>
おやりになりたいことはどういうことですか?
たとえば、
[Sheet3]の[A1]セルで Ctrl+Shift+[*]をすると、
表範囲が求まりますよね?
この範囲がAutoFilter.Range です。その状態で、
A列が「あああ」でAutoFilterをかけると、こうなります。↓

[Sheet3]フィルタ後
1 項目      A    B    C
2 あああ      2    15    30
4 あああ      5    30     5
5 あああ      6     7     8
6 あああ      12     7    15
8 あああ      7     8     9

この状態で、一行目を除いて、範囲全体をCOPYして
「あああ」シートの[A1]セルで
Transpose:=True で PasteSpecial しますと、
こうなります。

Sheet「あああ」-------------------------
  A      B    C    D    E
1 ああ    あああ    あああ    あああ    あああ
2 2     5    6    12    7
3 15    30    7     7    8
4 30     5    8    15    9

↑これでは まずいんですよね?

>sheet2:
>あああ あああ 一 あああ あああ 一 あああ
> 2    5   列  6   12   列  7        
> 15    30   空  7    7   空  8
> 30    5       8    15     9        

空白行を挿入したいということでしたら、抽出した全範囲を
一括コピーしてから(COPYコマンドは 可視行だけCOPYしてくれますので)、
コピー先シートのほうで空の列挿入してはどうでしょう?

【62222】Re:Forで、条件に当てはまらない場合次の...
発言  チューリップ  - 09/7/2(木) 14:34 -

引用なし
パスワード
   こんにちは、さっそくのレスありがとうございます。
私がやりたいことは、kanabunさんの仰るとおりです。
ですが、
>空白行を挿入したいということでしたら、抽出した全範囲を
>一括コピーしてから(COPYコマンドは 可視行だけCOPYしてくれますので)、
>コピー先シートのほうで空の列挿入してはどうでしょう?

残念ながら、その方法はとれません。
なぜなら、貼り付け先のシートはすでに書式設定済だからです。

一行空ける部分は、sheetあああでスタイルを綺麗に見せるために一行空けているスペースなんです。
かなり複雑な条件付書式なども設定しているので、それをやり直すのは面倒・・・というところです。
空の列挿入で、値のみ右に移動とかいうことができれば別ですが。
それってできるのでしょうか

【62223】Re:Forで、条件に当てはまらない場合次の...
発言  SS  - 09/7/2(木) 14:37 -

引用なし
パスワード
   ▼チューリップ さん:

こんにちは、質問への直接の回答ではないのですが

貼付け列設定をする際にt - startを使っていますがこれをもう一つ新しい変数を使うというのはいかがですか?
For文で一回りするたびにi=i+1で、3の倍数ごとにさらに+1(空白分)という感じで
出来ると思うのですが

  i = 0
>  For t = start To last
   If ActiveCell.Column Mod 3 <> 0 Then
     i = i + 2
   Else
     i = i + 1
   End If:
>  Selection.Offset(, i).Select
>  'オートフィルターで抽出した行数分右にコピーしていきます。
>

【62224】Re:Forで、条件に当てはまらない場合次の...
発言  つん  - 09/7/2(木) 14:46 -

引用なし
パスワード
   ▼チューリップ さん
こんにちは^^
横から失礼します。

貼り付け先の、列を決める変数をもひとつ用意されたらどうですか?

  k = 1
  For t = start To last
  
    If Worksheets("Sheet3").Rows(t).Hidden = False Then ’※1
      If k Mod 3 = 0 Then k = k + 1
      Worksheets("Sheet3").Cells(t, 1).Resize(, 4).Copy
      Worksheets("あああ").Cells(1, k).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
             :=False, Transpose:=True
      k = k + 1
    End If
      
  Next t

※1・・これいれておかないと、非表示になってる行もコピーちゃいませんか?

あ、コピー処理んとこも、変えてみましたが、こっちのがすっきりするかな〜・・・と。
いちいち、「ナンタラ.Activate」→「Selection.カンタラ」ってしなくても、直に処理してもOKですよ^^
たまに、しないとダメな場合もあるけど。

【62225】Re:Forで、条件に当てはまらない場合次の...
お礼  チューリップ  - 09/7/2(木) 14:54 -

引用なし
パスワード
   つんさん、SSさんありがとうございます。
なるほど・・・と思いました。
早速教えていただいたとおり作業に取り掛かりたいと思います。
少し時間がかかるかもしれませんが、結果報告いたしますので、よろしくお願いします。

kanabunさんもありがとうございました!

【62226】Re:Forで、条件に当てはまらない場合次の...
お礼  チューリップ  - 09/7/2(木) 15:27 -

引用なし
パスワード
   皆様ありがとうございました!

つんさんの方法でバッチリできました!

それにしてもすっきりしたプログラムですね。
裁縫の世界で"下手の長糸"という言葉がありますが、
プログラムの世界でも"下手の長プログラム"とかありそうですね。

まだまだ勉強不足を痛感いたしました。

SSさん、kanabunnさん、ありがとうございました。

また何かあったらお邪魔しますので、そのときはよろしくお願いいたします。

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