excel2000でVBAのコード相談

質問

添付図にあるように、

Ａ列　日付
Ｂ列　時刻
Ｃ列　値

という表があります。

そして、画像のように

値が3以上の時の、日付と時刻を、Ｆ列～Ｊ列の表に書き出したいです。

書き出す表は、上から順に 1回目が9行目、2回目が10行目、3回目が11行目 ・・・

といった具合です。

どういったコードがいいか、なかなか思い浮かばず、いいものを教えていただければ幸いです。

よろしくお願いいたします。

回答No.1

keithin · ベストアンサー

まぁ一行ずつ舐め回していって書き出してもさほどの手間ではないと思いますが，ざっとこんなカンジでも。

sub macro1()
　dim n as long
　dim Target as range
　dim ha as range
　dim h1 as range, h2 as range

’条件調査
　if application.countif(range("C:C"), ">2") = 0 then exit sub
　range("F9:G65536,I9:J65536").clearcontents

’初期化
　range("A1:C" & range("A65536").end(xlup).row).autofilter field:=3, criteria1:=">=3"
　set target = range("A2:C" & range("A65536").end(xlup).row)
　n = 8

’カタマリごとにコピー
　for each ha in target.specialcells(xlcelltypevisible).areas
　　set h1 = ha.cells(1).resize(1, 2)
　　set h2 = ha.cells(ha.count).offset(0, -2).resize(1, 2)
　　n = n + 1
　　h1.copy destination:=cells(n, "F")
　　h2.copy destination:=cells(n, "I")
　next
　activesheet.autofiltermode = false
end sub

＃作業列を丁寧に使って関数だけで仕上げる事もできそうですが，マクロの方が手っ取り早いです。

お礼

ご返事、遅れて申し訳ございません。回答、ありがとうございました。

keithin様のコードは、とにかく無駄がなく、シンプル。で理想的だと思います。

私が自分で作ろうとすると、無駄に長くなりすぎて、処理スピードも遅いものが出来てしまいます。

そして、コードをご提示いただいて、あぁなるほど。となんとか理解出来たときの喜びを感じることができます。

本当にありがとうございました。

回答No.3

某HN クロメート(Chromate)（@CoalTar）

VBAは自動記録＋α程度の知識しかないので 数式でやってみました
D1セル 0
D2セル =AND(C2>=3,C1<3)+AND(C2<3,C1>=3)+D1
下へオートフィル
最下行が3以上 かつ 終わり の可能性があるなら
最下行＋1行までオートフィルします

E9セル 下へ連番
書式 - 表示形式 - ユーザー定義
第0回目

F9セル
=IF(MAX($D:$D)<$E9*2,"",INDEX(A:A,MATCH($E9*2-1,$D:$D)+1))
右へ下へオートフィル

I9セル
=IF(MAX($D:$D)<$E9*2+1,"",INDEX(A:A,MATCH($E9*2,$D:$D)))
右へ下へオートフィル

お礼

ご返事遅くなり、申し訳ございません。回答ありがとうございました。

関数だけを駆使して、やり遂げる回答者様の柔軟さには、感服いたしました。

回答No.2

imogasi

何が聞きたいのか明確にして質問のこと。
図だけでは、はっきりわからない。
処理を１歩一歩文章に箇条書きしてみること。
＞値が3以上の時の、
これは色々なやり方があるが、全行について値が３以上かどうか、判別して、以上だったら処理をすれば良い。
For i= 1 to d
処理
Next i
で仕舞いだろう。dはデータ最終行の行番号
ーー
しかし処理が文章で、明確に文章になっていない。
各３以上の塊の「連（つらなり）」の最初と最後を左右の列に書き出すのが主旨だろう。
ーー
ロジックはどう考えたのか。
＞相談 、といっても丸投げではないか。何処までやってみた？特にロジックは、色々なやり方が考えられるが、考えてみたか？ここが初心者には訓練がされておらず、出にくいようだ。
ーー
一例（といっても、「コントロールの処理」という基本的な処理パターンだ）
（１）３以上のものが現れたら、まず左側の箱に書き出す。そのとき書き出す行のために行ポインタを＋１して前回分の下にずらす。
　　右の箱にも書き出る（最終決定ではないが、とりあえず）。連のサインをON。
（２）次の行を読んで３以上なら、（連（つらなり）の中の場合）右の箱（終わり・エンド）だけを書き直し。
（３）３以下なら、何もしない。ただしここで連は途切れたので、連のサインをOFF。
（４）最終行が来たら終わり
ーー
コード
Sub test01()
d = Range("A65536").End(xlUp).Row
'MsgBox d
j = 8 '右の箱の最初行の手前行
ren = "n" '続きの中か
For i = 2 To d 'データは２行目から
If Cells(i, "C") >= 3 Then
If ren = "n" Then '連なりの途中（連の最初）でないなら
'--左の箱
j = j + 1
Cells(j, "F") = Cells(i, "A")
Cells(j, "G") = Cells(i, "B")
'--右の箱
Cells(j, "I") = Cells(i, "A")
Cells(j, "J") = Cells(i, "B")
ren = "y"
Else
'--連なりの途中（連の最初）なら、右の箱　　だけ上書き（ｊは変えてないことに留意）
Cells(j, "I") = Cells(i, "A")
Cells(j, "J") = Cells(i, "B")
End If
Else
ren = "n"
End If
Next i
End Sub
ーー
余り沢山のデータでテストしていないので、可笑しなケースがあればご免。
例データ　時刻は省略　A1:C13
日付 時刻 値
2011/4/1 3
2011/4/2 4
2011/4/3 6
2011/4/4 1
2011/4/5 1
2011/4/6 3
2011/4/7 6
2011/4/8 2
2011/4/9 2
2011/4/10 4
2011/4/11 2
2011/4/12 7
ーー
結果　F9:I12
2011/4/1 2011/4/3
2011/4/6 2011/4/7
2011/4/10 2011/4/10
2011/4/12 2011/4/12

お礼

ご返事おそくなり、申し訳ございません。

本件、自分で作成しようと、途中で挫折してしまったのですが、

質問の仕方として、全容が分かる形のものがいいかと思い。

と考えてしまいました。

以後、質問の仕方を気をつけます。ありがとうございました。