![](http://oshiete.xgoo.jp/images/v2/pc/qa/question_title.png?e8efa67)
以下のエクセル表があり、同じ日付ごとのデータを自動的に別のシートに移したいです。
例えば、別のシートに、2004/1/1に書かれているデータのみを移す。(シート2参照)
それをVBAで書くにはどうすればいいでしょうか。
マクロの記録をするのではなく、この表の日付を増やしたり変えたりしても機能するようにコードを書きたいと思っております。
For LoopとIf thenを使い、A1セルがそれより下のセルの値と異なるまでコピーし続ける、、といった作業をすればよいのでしょうか。
全くの初心者で勉強中です。よろしくお願いいたします。
列行 A B
1 2004/1/1 太郎
2 2004/1/1 次郎
3 2004/1/1 三郎
4 2004/1/1 一郎
5 2004/1/1 五郎
6 2005/3/3 三郎
7 2005/3/3 次郎
8 2005/3/3 太郎
9 2005/3/3 四朗
10 2006/2/2 次郎
11 2006/2/2 一郎
12 2006/2/2 太郎
シート2
2004/1/1
太郎
次郎
三郎
一郎
五郎
シート3
2005/3/3
三郎
次郎
太郎
四朗
シート4
2006/2/2
次郎
一郎
太郎
A 回答 (2件)
- 最新から表示
- 回答順に表示
No.2
- 回答日時:
とりあえず下記のソースでご質問された内容の動作ができてる?ことを確認したので
試してみてください。
使うときの注意点として、
A列には日付、B列には名前を必ず入力することと、
一番左側のワークシート以外は全部削除してしまうので、
下記のプログラムを実行する前にSheet2やSheet3といったワークシートが
削除されてもいいか確認してください。
もし必要であればプログラムの解説もいたします。
Public Sub sub_SplitDate()
Dim i As Long, j As Long, k As Long
Dim lngBeforeDate As Long
Dim lngAfterDate As Long
Dim wbkActiveSheet As Worksheet
Dim rngInputData As Range
Dim r As Range
Dim lngLastRow As Long
Dim varInputArray As Variant
Set wbkActiveSheet = ActiveSheet
With Worksheets(1)
lngLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
For i = 1 To lngLastRow
If i = lngLastRow Then Exit For
lngBeforeDate = DateValue(.Cells(i, 1).Value)
lngAfterDate = DateValue(.Cells(i + 1, 1).Value)
If lngBeforeDate = lngAfterDate Then
Else
j = j + 1
End If
Next i
j = j + 1
If Worksheets.Count > 1 Then
For i = 2 To Worksheets.Count
Application.DisplayAlerts = False
Worksheets(2).Delete
Application.DisplayAlerts = True
Next i
End If
For i = 1 To j
Worksheets.Add after:=Worksheets(Worksheets.Count)
Next i
wbkActiveSheet.Activate
j = 2
k = 1
For i = 1 To lngLastRow
If i = lngLastRow Then Exit For
' MsgBox Worksheets(1).Cells(i, 2).Value
lngBeforeDate = DateValue(.Cells(i, 1).Value)
lngAfterDate = DateValue(.Cells(i + 1, 1).Value)
If lngBeforeDate = lngAfterDate Then
With Worksheets(j)
If k = 1 And i = 1 Then
MsgBox Worksheets(1).Cells(i, 2).Value
.Cells(k, 1).Value = Worksheets(1).Cells(i, 1).Value
k = k + 1
.Cells(k, 1).Value = Worksheets(1).Cells(i, 2).Value
k = k + 1
Else
.Cells(k, 1).Value = Worksheets(1).Cells(i, 2).Value
k = k + 1
End If
End With
Else
Worksheets(j).Cells(k, 1).Value = Worksheets(1).Cells(i, 2).Value
j = j + 1
k = 1
Worksheets(j).Cells(k, 1).Value = Worksheets(1).Cells(i, 1).Value
k = k + 1
Worksheets(j).Cells(k, 1).Value = Worksheets(1).Cells(i, 2).Value
End If
Next i
Worksheets(j).Cells(k, 1).Value = Worksheets(1).Cells(lngLastRow, 2).Value
End With
End Sub
No.1
- 回答日時:
>For LoopとIf thenを使い、A1セルがそれより下のセルの値と異なるまでコピー
セルを一つ一つ舐め回して書き写していくのは,まぁ一番「簡単そう」なのでそういうやり方を好むヒトもいますが,一番遅くて効率の悪い方法です。
幾つか,ご相談の言葉足らずで前提条件が不明な箇所があります。
●そもそもふつーは1行目にタイトル行,2行目から実データにしますが,ホントにご質問で例示されたようにいきなり一行目から実データを列記しているのですか。
●A列の日付は,必ず昇順で既に並べ替えてあるのですか。それともホントは順不同のデータを処理したいのですか。
●いまは「1/1のデータを移す」と,あたかもリストに1/1があり3/3がある事が「既知の事実」であるかのように書かれていますが,ホントにやりたいのは「日付に該当するシートもマクロで作成する」ところからではないのですか。それともそこは判ってるので質問していない(回答不要)のですか。
準備:
ブックを開く
Sheet1にデータを用意する
ALT+F11を押す
挿入メニューから標準モジュールを挿入する
標準モジュールにマクロを記載する
作成例:
sub macro1()
dim h as range
for each h in worksheets("Sheet1").range("A1:A" & worksheets("Sheet1").range("A65536").end(xlup).row)
’シートを用意する
if application.countif(worksheets("Sheet1").range("A1:A" & h.row), h.value) = 1 then
worksheets.add after:=worksheets(worksheets.count)
activesheet.name = format(h.value ,"yyyymmdd")
h.copy destination:=range("A1")
end if
’データを転記する
worksheets(format(h.value, "yyyymmdd")).range("A65536").end(xlup).offset(1).value = h.offset(0, 1).value
next
end sub
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Excel(エクセル) エクセルVBA VLOOKUPを使ってのカウント作業 2 2023/02/19 09:03
- Visual Basic(VBA) ExcelのVBAコードについて教えてください。 1 2023/02/02 13:13
- Excel(エクセル) エクセルの数式で教えてください。 1 2022/10/25 09:26
- Visual Basic(VBA) ExcelのVBAコードについて教えてください。 1 2023/02/02 09:25
- Excel(エクセル) エクセルの参照について教えてください 1 2022/12/08 16:06
- Excel(エクセル) エクセルの数式で教えてください。 2 2023/02/10 17:07
- Excel(エクセル) エクセルの数式で教えてください。 2 2023/01/12 09:24
- その他(データベース) 20万行あるデータを動かしたい 2 2023/06/13 15:21
- Visual Basic(VBA) エクセルについて教えてください。 3 2023/06/28 09:11
- 日本語 日本語のアクセントについて 2 2022/04/28 22:57
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
EXCELのSheet番号って変更でき...
-
マクロの「SaveAs」でエラーが...
-
Unionでの他のシートの参照につ...
-
楽天RSSからエクセルVBAを使用...
-
VBA 空白行に転記する
-
Count Ifのセルの範囲指定に変...
-
VBAで変数の数/変数名を動的に...
-
アクセスからエクセルへ出力時...
-
ExcelのVBマクロを、バックグラ...
-
エクセルのVBAで条件を別シート...
-
VBA 実行時エラー1004 rangeメ...
-
マクロ実行後に別シートの残像...
-
まとめシートから集計シートへA...
-
テキストボックスから、複数の...
-
VBA Userformで一部別シートに...
-
Excel VBA オートフィルターで...
-
vba 連続するとうまく作動せず
-
GASでチェックボックスを一括of...
-
100万件越えCSVから条件を満た...
-
Excel2013で切り取り禁止
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
マクロの「SaveAs」でエラーが...
-
VBA 空白行に転記する
-
EXCELのSheet番号って変更でき...
-
マクロ実行後に別シートの残像...
-
VBA別シートの最終行の次行へ転...
-
Count Ifのセルの範囲指定に変...
-
Changeイベントで複数セルへの...
-
VBAで変数の数/変数名を動的に...
-
VBA 別ブックからの転記の高速...
-
【VBA】特定の条件でセルをコピー
-
VBA 実行時エラー1004 rangeメ...
-
楽天RSSからエクセルVBAを使用...
-
Unionでの他のシートの参照につ...
-
複数シートの複数列に入力され...
-
ExcelのVBマクロを、バックグラ...
-
100万件越えCSVから条件を満た...
-
VBA Userformで一部別シートに...
-
Excel VBA オートフィルターで...
-
Excel2013で切り取り禁止
-
VBAでEXCELから固定長...
おすすめ情報