こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

Microsoftマイクロソフトのエクセルでマクロ

MicrosoftマイクロソフトのエクセルでマクロVBAをやりたいです。 プログラムがちょっとわかりません。

sheet1、sheet2、sheet3を参照します。各sheetの中は写真のようなデータが入ってます。
sheet1から始めます。
列Aの3行から23行までをみます。
◯が書いてあったら、その行をsheet4に貼り付けます。
順次、23行まで繰り返します。
次のsheet2も同じ事を繰り返します。
次のsheet3も同じ事を繰り返します。
sheet4に◯が書かれた行の一覧が出来れば成功です。
可能でしょうか?
出来れば、モジュールmoduleに貼り付けるだけで終わるようにプログラム教えてもらえますか?

投稿日時 - 2016-07-28 09:54:19

QNo.9207680

困ってます

質問者が選んだベストアンサー

No1の追加です。

モジュールのコードを記載する画面の一番上に
Option Base 1
を追加してください。

投稿日時 - 2016-07-28 11:32:25

お礼

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

投稿日時 - 2016-07-28 12:51:33

ANo.2

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(4)

ANo.4

これこそ丸投げの質問で、まる写しを希望しているが、もう少し本なり、WEBの例題を調べて、勉強して、行き詰まった点に絞って質問すべきだ。
適した一部の人を除いて、例えスクリプトでもプログラムの独学は時間がかかり難しいと思う。そっくりのコードを書いてくれでは、進歩しないと思う。
ーー
それに添付画像がぼやけて読みにくい。回答者は、テストデータで自分のコードをテストして、確認すると思うが、そのテストデータ作りを回答者にやれというのは手数がかかる。
下記のような質問の書き方を参考にしてみて。
ーー
例示するのは、シート数は複数の場合2,3シートで済むし、行数も4-5行程度あれば済むことが多い。
ーー
テストデータ(セルにコピー貼り付けして、データー区切り位置でセルにバラける)
Sheet1 A-D列
1ax1x1
○2ax2x2
3ax3x3
4ax4x4
5ax5x5
○6ax6x6
7ax7x7
8ax8x8
Sheet2 A-D列
1bxb1xb1
○2bxb2xb2
3bxb3xb3
4bxb4xb4
○5bxb5xb5
6bxb6xb6
7bxb7xb7
○8bxb8xb8
Sheet3 A-D列
○1cXC1XC1
2cXC2XC2
3cXC3XC3
○4cXC4XC4
5cXC5XC5
6cXC6XC6
7cXC7XC7
○8cXC8XC8
標準モジュールに
Sub test01()
Set sh4 = Worksheets("Sheet4") '集約シート
j = 2 ’Sheet4での行番号ポインタ,初期設定
For Each sh In Worksheets
If sh.Name <> sh4.Name Then '処理対象にしない
’MsgBox sh.Name
For i = 3 To 23
If sh.Cells(i, "A") = "○" Then
’ MsgBox i
' sh4.Range(Cells(j, "A"), Cells(j, "C")) = sh.Range(sh.Cells(i, "B"), sh.Cells(i, "D"))
'個別セル代入法
     'sh4.Cells(j, "A") = sh.Cells(i, "B")
    'sh4.Cells(j, "A") = sh.Cells(i, "C")
    'sh4.Cells(j, "A") = sh.Cells(i, "D")
' コピー貼り付け法
'sh.Range(sh.Cells(i, "B"), sh.Cells(i, "D")).Copy sh4.Cells(j, "A")
' 一旦配列に代入法
c = sh.Range(sh.Cells(i, "B"), sh.Cells(i, "D"))
sh4.Range(Cells(j, "A"), Cells(j, "C")) = c
j = j + 1

End If
Next i
End If
Next
End Sub
ーー
結果
Shee4
2ax2x2
6ax6x6
2bxb2xb2
5bxb5xb5
8bxb8xb8
1cXC1XC1
4cXC4XC4
8cXC8XC8
すでに配列に入れる方法が回答があるようだが
FOR  EACH法もあり便利な点もある。 何が便利か勉強のこと。
ーー
該当データをSheet4に移すとき
(1)Copy・貼り付け法
(2)項目(=列)の各セルを列挙法
(3)ヴァリアント配列法
などがある。この考えは今後、役に立つと思う。
ーーー
手を抜いているが、上記コードで不適当な点がある。何か考えてみて。

投稿日時 - 2016-07-28 14:12:20

ANo.3

Option Explicit
Sub Test()
Dim s, t As Sheets
Dim i, j, k, l As Integer
l = 0
For i = 1 To 3
Set s = ThisWorkbook.Worksheets(i)
For j = 3 To 23
If s.Cells(j, 1).Value = "○" Then
l = l + 1
For k = 4 To 6
ThisWorkbook.Worksheets(4).Cells(l, k).Value = s.Cells(j, k).Value
Next k
End If
Next j
Set s = Nothing
Next i
End Sub

3つのシートを調べるので「For i = 1 to 3」としています。

調べるシートを「Set」しています(このとき、シートの名前は何でも構いません。左端から、順番に1、2、3となります)。

それぞれのシートの3行目から23行目まで調べます。

「A」列に「○」があれば、「D」列から「F」列を4番目のシートにコピーします。

以上です。

投稿日時 - 2016-07-28 13:41:44

ANo.1

こちらを貼り付けて実行 シート名Sheet1などは実際のシート名に変更してください。
Sub Example()
Dim sh(4) As Worksheet
Dim i As Long, j As Long, k As Long

Set sh(1) = Worksheets("Sheet1")
Set sh(2) = Worksheets("Sheet2")
Set sh(3) = Worksheets("Sheet3")
Set sh(4) = Worksheets("Sheet4")

k = sh(4).Cells(Rows.Count, "A").End(xlUp).Row + 1
If k < 3 Then
k = 3
End If
For i = 1 To 3
For j = 3 To 23
If sh(i).Cells(j, "A") = "◯" Then
' sh(i).Cells(j, "A").Resize(1, 6).Copy sh(4).Cells(k, "A").Resize(1, 6)
' 書式の設定も移したい場合には↑左端の'を消し↓の左端に'を入れる
sh(4).Cells(k, "A").Resize(1, 6).Value = sh(i).Cells(j, "A").Resize(1, 6).Value
' データだけで移す↑
k = k + 1
End If
Next j
Next i
For i = 1 To 4
Set sh(i) = Nothing
Next i
End Sub

投稿日時 - 2016-07-28 11:02:46

あなたにオススメの質問