『VBA 新たに入力されたデータのみ代入』（1250）
いつもお世話になっております。
入力シートに入力された新たなデータのみをデータ一覧に反映させたいです。
＜入力＞
A B C D E F G
1 日付 種類1 種類2 種類3 名前1 名前2 名前3
2 4/1 ○○ ▲▼ □ S藤 Y田
3 4/1 ▲▼ S藤
4 4/3 □◆ ○○ ☆☆ Y田 S木 K島
5 4/4 ☆☆ ○○ S木 K島
↓
＜データ一覧＞
A B C
1 日付 名前 種類
2 4/1 S藤 ○○
3 4/1 S藤 ▲▼
4 4/1 S藤 □
5 4/1 Y田 ○○
6 4/1 Y田 ▲▼
7 4/1 Y田 □
8 4/1 S藤 ▲▼
9 4/3 S藤 □◆
下記のVBAを作成しましたが一番下（最新行）のデータではなく途中のデータが反映されてしまいました。
Sub test()
Dim lastrow As Long
lastrow = Worksheets("データ一覧").Cells(Rows.Count, 1).End(xlUp).Row
'入力データをデータ一覧に代入
Worksheets("データ一覧").Cells(lastrow + 1, 1) = Worksheets("入力").Cells(lastrow + 1, 1) '日付
Worksheets("データ一覧").Cells(lastrow + 1, 2) = Worksheets("入力").Cells(lastrow + 1, 5) '名前1
Worksheets("データ一覧").Cells(lastrow + 1, 2) = Worksheets("入力").Cells(lastrow + 1, 6) '名前2
Worksheets("データ一覧").Cells(lastrow + 1, 2) = Worksheets("入力").Cells(lastrow + 1, 7) '名前3
Worksheets("データ一覧").Cells(lastrow + 1, 3) = Worksheets("入力").Cells(lastrow + 1, 2) '種類1
Worksheets("データ一覧").Cells(lastrow + 1, 3) = Worksheets("入力").Cells(lastrow + 1, 3) '種類2
Worksheets("データ一覧").Cells(lastrow + 1, 3) = Worksheets("入力").Cells(lastrow + 1, 4) '種類3
End Sub
ご教示のほどよろしくお願いいたします。
＜ 使用 Excel：Excel2013、使用 OS：Windows10 ＞
[データ一覧]シートと[入力]シートで最終行の位置が違えばそうなるかもしれませんね [データ一覧]シートの最終行と、[入力]シートの最終行は、それぞれ別に取得しましょう
また、[入力]シートの最終行の１行下を参照してもそこは空白のハズなので、何も書き込まれないと思います。 （´・ω・`） 2024/03/29(金) 16:12:44
（mm） 2024/04/01(月) 13:11:45
返信が遅くなり申し訳ございません。
体調を崩しており確認できておりませんでした。
教えていただいたことを確認しまた返信いたします。
取り急ぎお礼申し上げます。
（1250） 2024/04/02(火) 11:23:03
その際、１セルずつ書き込みをするとデータ量によっては時間がかかってしまうので、下記のように配列にデータを集めておいて【一気に書き込む】ことを考えてみてもよいかもしれません。
Sub 研究用()
Dim buf As Long, 行 As Long, i As Long, 種類列 As Long, 名前列 As Long
Dim 配列() As Variant
With Worksheets("入力")
For 行 = 2 To .Cells(.Rows.Count, "A").End(xlUp).Row
buf = buf _
+ WorksheetFunction.CountA(Intersect(.Rows(行), .Range("B:D"))) _
* WorksheetFunction.CountA(Intersect(.Rows(行), .Range("E:G")))
Next 行
ReDim 配列(buf - 1, 2)
For 行 = 2 To .Cells(.Rows.Count, "A").End(xlUp).Row
For 種類列 = 2 To 4
For 名前列 = 5 To 7
If .Cells(行, 種類列).Value <> "" And .Cells(行, 名前列).Value <> "" Then
配列(i, 0) = .Cells(行, "A").Value
配列(i, 1) = .Cells(行, 種類列).Value
配列(i, 2) = .Cells(行, 名前列).Value
i = i + 1
End If
Next 名前列
Next 種類列
Next 行
End With
With Worksheets("データ一覧")
.Range("A2:C" & .Rows.Count).ClearContents
.Range("A2:C2").Resize(UBound(配列) + 1).Value = 配列
End With
End Sub
※上記は説明用の提示であり、完成品プレゼントの意図はありません。 ※採用される場合は、【ステップ実行】等により研究の上、理解納得してから必要な部分のみ ご自身のコードに組み込んでください。
（もこな２） 2024/04/02(火) 22:30:32
説明不足の質問に答えていただきありがとうございました<m(__)m>
ｍｍ様
ご指摘ありがとうございます。
＜入力シート＞
A B C D E F G
1 日付 種類1 種類2 種類3 名前1 名前2 名前3
2 4/1 ○○ ▲▼ □ S藤 Y田
3 4/1 ▲▼ S藤
4 4/3 □◆ ○○ ☆☆ Y田 S木 K島
4行目までは既に入力されています。
5 4/4 ☆☆ ○○ S木 K島
5行目（4/4のデータ）を入力しマクロを実行するとデータ一覧シートの最終行に追加したいです。
＜データ一覧シート＞
A B C
1 日付 名前 種類 2 4/1 S藤 ○○ 3 4/1 S藤 ▲▼ 4 4/1 S藤 □ 5 4/1 Y田 ○○ 6 4/1 Y田 ▲▼ 7 4/1 Y田 □ 8 4/1 S藤 ▲▼ 9 4/3 Y田 □◆ 10 4/3 Y田 ○○ 11 4/3 Y田 ☆☆ 12 4/3 S木 □◆ 10 4/3 S木 ○○ 11 4/3 S木 ☆☆ 12 4/3 K島 □◆ 13 4/3 K島 ○○ 14 4/3 K島 ☆☆ 15 4/4 S木 ☆☆ 16 4/4 S木 ○○ 17 4/4 K島 ☆☆ 18 4/4 K島 ○○
14行目までは既に入力されておりマクロ実行で15〜18行目に追加したいです。
もこな２様
コメントありがとうございます。
その都度全て更新でも構いません。ただ数年分のデータがあります。
配列にデータを集めておいて【一気に書き込む】というのはどういうことでしょうか？
（1250） 2024/04/04(木) 16:21:39
1行入力してマクロ実行という運用ということなら、
Public Sub Test()
Dim InputWS As Worksheet, ListWS As Worksheet
Set InputWS = Worksheets("入力")
Set ListWS = Worksheets("データ一覧")
Dim InputNewRow As Long, OutputRow As Long
InputNewRow = InputWS.Cells(Rows.Count, 1).End(xlUp).Row
OutputRow = ListWS.Cells(Rows.Count, 1).End(xlUp).Row + 1
Dim KCol As Long, NCol As Long, i As Long
For KCol = 2 To 4
If InputWS.Cells(InputNewRow, KCol).Value = "" Then Exit For
For NCol = 5 To 7
If InputWS.Cells(InputNewRow, NCol).Value = "" Then Exit For
ListWS.Cells(OutputRow, 1) = InputWS.Cells(InputNewRow, "A").Value
ListWS.Cells(OutputRow, 2) = InputWS.Cells(InputNewRow, KCol).Value
ListWS.Cells(OutputRow, 3) = InputWS.Cells(InputNewRow, NCol).Value
OutputRow = OutputRow + 1
Next
Next
End Sub
（hatena） 2024/04/04(木) 18:00:48
■１
＞5行目（4/4のデータ）を入力しマクロを実行する
要は、（消されてしまいましたが）半平太さんが予測されたように【入力】シートの最終行を転記すれば良いわけですね。
それでは、（´・ω・`）さんのアドバイスは理解できましたか？
それが理解出来たら解決する話のようにも思えますが・・・・
■２
＞【一気に書き込む】というのはどういうことでしょうか？
提示したとおりです。
.Range("A2:C2").Resize(UBound(配列) + 1).Value = 配列
↑で一気に書き込んでいる
■３
配列はよくわからないので使いたくないという場合でも、1セルずつ書き込むのではなく、１セットずつコピペするというアプローチ（３×３＝最大で９回）にするのも有効だとおもいます。
(１セルずつ書き込んだとしても最大27回ですから好みで決めてよいレベルかと思います。）
Sub 研究2()
Dim 行 As Long, 種類列 As Long, 名前列 As Long
With Worksheets("入力")
行 = .Cells(.Rows.Count, "A").End(xlUp).Row
For 種類列 = 2 To 4
For 名前列 = 5 To 7
If .Cells(行, 種類列).Value <> "" And .Cells(行, 名前列).Value <> "" Then
Union(.Cells(行, "A"), .Cells(行, 種類列), .Cells(行, 名前列)).Copy _
Worksheets("データ一覧").Cells(.Rows.Count, "A").End(xlUp).Offset(1)
End If
Next 名前列
Next 種類列
End With
End Sub
※繰り返しになりますが、上記は説明用の提示であり完成品プレゼントの意図はありません。 ※採用される場合は、【ステップ実行】等により研究の上、理解納得してから必要な部分のみ ご自身のコードに組み込んでください。
（もこな２ ） 2024/04/05(金) 14:59:47
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.