VBAで表を作りたいのだけれど、、

質問

Excel2007VBAについての質問です。

結構膨大な量のデーターを検証しないといけないので、
お粗末ながらのマクロorVBAを作りたいのですが、
付け焼刃で参考書開いてもよくわからない感じになっています。

やりたいことを簡単に言うと、
Sheet1とSheet2を準備して、Sheet1のA1に値を入れるとB1に計算値が出るようなシートを作りました。
(1)Sheet1のA1B1をコピーして、Sheet2のA1B1にペーストしました。
(2)Sheet1のA1に別の値を入れB1の値も変化しました。
(3)A1B1をコピーして、Sheet2のA2B2にペーストしました。
というようにどんどんコピペで
Sheet2に表を作りたいのですがうまくいきません。

どなたか、お力かしてください。。

回答No.1

keithin · ベストアンサー

ブックを開く
ALT+F11を押す
現れた画面で挿入メニューから標準モジュールを挿入する
現れたシートに下記をコピー貼り付ける

sub macro1()
worksheets("Sheet1").copy _
destination:=worksheets("Sheet2").range("A65536").end(xlup).offset(1)
end sub

ファイルメニューから終了してエクセルに戻る
シート１にオートシェイプの図形を一個は位置してボタン代わりにする
右クリックしてマクロの登録で今登録したマクロを指定する
A1にデータを記入し
B1の結果を確認したら
ボタンをポチッとして結果を記録する。

【次のステップ】
A1に記入するデータリストをどこか別に用意する(たとえばC1:C10)
応用のマクロを作成し，用意のデータリストを上から次々拾ってはA1に記入させ，
計算結果を次々リストの隣に書き写していかせる

sub macro2()
　dim i as long
　for i = 1 to 10
　range("A1") = cells(i, "C")
　cells(i, "D") = range("B1")
　next i
end sub

お礼

質問内容とは違ったのですが、実質やりたいことがスパっとできました。
つたない質問文なのに噛み砕いて考えていただきありがとうございました。

捕捉で最初のステップがどうしてもエラーになってしまいました。
知識がなくて申し訳ないのですがどこがいけないんでしょう??

ただ、作業自体はSheet1で表作ってからSheet2にまとめて移せば良いだけなので全く問題ありませんでした。

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

回答No.4

freetaka

すいません
処理がたらなかったので修正

Sub CopyData()

Dim RowEnd As Long

'Excel2007以前は65575,以降は1048576が行数のリミット
Const RowLimit = 1048576

If Sheets("Sheet2").Cells(1, 1) = "" Then
'初回のみ"A1"のセルにデータコピー
Sheets("Sheet2").Cells(1, 1) = Sheets("Sheet1").Cells(1, 1)
Sheets("Sheet2").Cells(1, 2) = Sheets("Sheet1").Cells(1, 2)
Else
'データのある最終行を取得し１行足す
RowEnd = (Sheets("Sheet2").Cells(RowLimit, 1).End(xlUp).Row) + 1

'データをコピーする（行数がリミット以外）
If RowEnd <= RowLimit Then
Sheets("Sheet2").Cells(RowEnd, 1) = Sheets("Sheet1").Cells(1, 1)
Sheets("Sheet2").Cells(RowEnd, 2) = Sheets("Sheet1").Cells(1, 2)
End If

End If
End Sub

回答No.3

freetaka

Excel2007は行数の限界値が違うので
こんな感じにしてみました
もし自分で確認してみたい時は
Msgbox (Rows.Count)
で行数を確認できます

Sub CopyData()

Dim RowEnd As Long

'Excel2007以前は65575,以降は1048576が行数のリミット
Const RowLimit = 1048576

If Sheets("Sheet2").Cells(1, 1) = "" Then
'初回のみ"A1"のセルにデータコピー
Sheets("Sheet2").Cells(1, 1) = Sheets("Sheet1").Cells(1, 1)
Sheets("Sheet2").Cells(1, 2) = Sheets("Sheet1").Cells(1, 2)
Else
'データのある最終行を取得し１行足す
RowEnd = (Sheets("Sheet2").Cells(RowLimit, 1).End(xlUp).Row) + 1

'データをコピーする（行数がリミット以外）
Sheets("Sheet2").Cells(RowEnd, 1) = Sheets("Sheet1").Cells(1, 1)
Sheets("Sheet2").Cells(RowEnd, 2) = Sheets("Sheet1").Cells(1, 2)
End If

End If
End Sub

お礼

修正まであげていただきありがとうございます。
すごい読みやすく、私でも理解できるVBAで、
すごい読みやすい＝間違い発見しやすいので
今後、この式をもとに応用できそうな内容でした。

回答No.2

hallo-2007

(1)Sheet1のA1B1をコピーして、Sheet2のA1B1にペーストしました。
(2)Sheet1のA1に別の値を入れB1の値も変化しました。
(3)A1B1をコピーして、Sheet2のA2B2にペーストしました。
つまり
Sheet2の最後の行に下に
Sheet1のA1,B1の値を入れる
ということですね。
Sub ボタン2_Click()
GYOU = Sheets("Sheet2").Range("A65536").End(xlUp).Offset(1, 0).Row
Sheets("Sheet2").Range("A" & GYOU).Value = Range("A1").Value
Sheets("Sheet2").Range("B" & GYOU).Value = Range("B1").Value
End Sub
こんな感じで考えてみてください。
データを入力するVBAでは頻繁に使用するパターンです。

お礼

こんなにきれいにまとめられるんですか!!
知らない言葉たちが、踊ってます(笑)
頑張ってVBA理解できるよう頑張ります。
ありがとうございます。