エクセル

質問

シート１～５まであります。別に情報シートを作成しています
それぞれ同じ原本から作成しています

全部のシートにＡ１～Ａ１０のセルに日付、B1～B10のセルに文字など入力がするところがあります
入力はＡ１から順番に入れていきます

例えば
保存ボタンを作成しておく
シート１のA1に日付、B１に”文字”を入力し、保存ボタンをおす
情報シートに日付と内容が一致する情報がなければ、
情報シートのＡ列にシート名、Ｂ列に日付、C列に入力した内容が
空白のところに出力される

こんな感じに作成できないでしょうか？

回答No.3

kkkkkm · ベストアンサー

シート１～５それぞれのシートにボタンがあって、そのシートのボタンを押すとそのシートの最終行の日付と文字が情報シートにあるデータと一致しなければ情報シートにデータを追加する
ということだとしたら以下のような感じでしょうか。

ボタンのマクロがCommandButton1_Clickとしたら
Private Sub CommandButton1_Click()
検索
End Sub

標準モジュールに

Sub 検索()
Dim c As Range
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim ws1LastRow As Long
Dim ws2LastRow As Long

Set ws1 = Sheets("情報シート")
Set ws2 = ActiveSheet

If ws2.Range("A1").Value = "" Or ws2.Range("B1").Value = "" Then
MsgBox "検索する日付もしくは語句が入力されていません。", vbCritical
Exit Sub
End If
If ws1.Range("A1").Value = "" Then
ws1LastRow = 0
Else
ws1LastRow = ws1.Cells(Rows.Count, "A").End(xlUp).Row
End If
ws2LastRow = ws2.Cells(Rows.Count, "A").End(xlUp).Row
For Each c In ws1.Range(ws1.Cells(1, "B"), ws1.Cells(Rows.Count, "B").End(xlUp))
If c.Value2 = ws2.Cells(ws2LastRow, "A").Value2 Then
If c.Offset(0, 1).Value = ws2.Cells(ws2LastRow, "B").Value Then
MsgBox "既にデータが存在します", vbInformation
Exit Sub
End If
End If
Next
ws1.Cells(ws1LastRow + 1, "A").Value = ws2.Name
ws1.Cells(ws1LastRow + 1, "B").Resize(1, 2).Value = ws2.Cells(ws2LastRow, "A").Resize(1, 2).Value
MsgBox "データを追加しました", vbInformation
Set ws1 = Nothing
Set ws2 = Nothing
End Sub

お礼

ありがとうございます
親切な説明文もついていて助かります

補足

完璧なプログラムありがとうございます
もしも今後D列とか追加したいものとか出てきた場合
どこら辺のプログラムをいじれば列を増やせるのでしょうか?
ご迷惑をお掛けしますが
返事もらえるとうれしいです

回答No.6

kkkkkm

No5の追加です。

入力してるかどうかの判断もC列まで増やさないといけないので変更になります。

If ws2.Range("A1").Value = "" Or ws2.Range("B1").Value = "" Or ws2.Range("C1").Value = "" Or _
ws2.Cells(Rows.Count, "A").End(xlUp).Row <> ws2.Cells(Rows.Count, "B").End(xlUp).Row Or _
ws2.Cells(Rows.Count, "B").End(xlUp).Row <> ws2.Cells(Rows.Count, "C").End(xlUp).Row Then
MsgBox "検索する日付もしくは語句が入力されていません。", vbCritical
Exit Sub
End If

お礼

ありがとうございます
これだけ教えて貰えたら
自分で追加できます

回答No.5

kkkkkm

> もしも今後D列とか追加したいものとか出てきた場合
> どこら辺のプログラムをいじれば列を増やせるのでしょうか?

増えるD列が情報シートだとすれば情報シート以外はC列になると思いますのでC列まで検索に含める場合

If c.Value2 = ws2.Cells(ws2LastRow, "A").Value2 Then
If c.Offset(0, 1).Value = ws2.Cells(ws2LastRow, "B").Value Then
If c.Offset(0, 2).Value = ws2.Cells(ws2LastRow, "C").Value Then
MsgBox "既にデータが存在します", vbInformation
Exit Sub
End If
End If
End If

If文が一つ増えることになります。この検索方法がベストかどうかは不明ですが、とりあえず頭に浮かんだので…データ量がそれほど多くないと思われたので検索スピードに関しては考えていません。

あとデータの代入ですが、シート名以外の部分は以下になります。シート名の代入ははそのままです。

ws1.Cells(ws1LastRow + 1, "B").Resize(1, 2).Value = ws2.Cells(ws2LastRow, "A").Resize(1, 2).Value

Resize(y,x)が基点のセルから基点のセルも含めてどれだけのセル範囲を対象とするかの指定になります。
B列も含めたD列までの範囲は1行3列分となりますから
ws1.Cells(ws1LastRow + 1, "B").Resize(1, 3).Value
と指定してください。
情報シート以外も列が同数増えると思いますので
ws2.Cells(ws2LastRow, "A").Resize(1, 2).Value
も
ws2.Cells(ws2LastRow, "A").Resize(1, 3).Value
になります。

お礼

ありがとうございます
工夫して増やしてみます

回答No.4

kkkkkm

No3です。
検索の方の訂正です。
日付、検索語句の未入力確認を一部訂正しました。

Sub 検索()
Dim c As Range
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim ws1LastRow As Long
Dim ws2LastRow As Long

Set ws1 = Sheets("情報シート")
Set ws2 = ActiveSheet

If ws1.Range("A1").Value = "" Then
ws1LastRow = 0
Else
ws1LastRow = ws1.Cells(Rows.Count, "A").End(xlUp).Row
End If
ws2LastRow = ws2.Cells(Rows.Count, "A").End(xlUp).Row
If ws2.Range("A1").Value = "" Or ws2.Range("B1").Value = "" Or _
ws2.Cells(Rows.Count, "A").End(xlUp).Row <> ws2.Cells(Rows.Count, "B").End(xlUp).Row Then
MsgBox "検索する日付もしくは語句が入力されていません。", vbCritical
Exit Sub
End If
For Each c In ws1.Range(ws1.Cells(1, "B"), ws1.Cells(Rows.Count, "B").End(xlUp))
If c.Value2 = ws2.Cells(ws2LastRow, "A").Value2 Then
If c.Offset(0, 1).Value = ws2.Cells(ws2LastRow, "B").Value Then
MsgBox "既にデータが存在します", vbInformation
Exit Sub
End If
End If
Next
ws1.Cells(ws1LastRow + 1, "A").Value = ws2.Name
ws1.Cells(ws1LastRow + 1, "B").Resize(1, 2).Value = ws2.Cells(ws2LastRow, "A").Resize(1, 2).Value
MsgBox "データを追加しました", vbInformation
Set ws1 = Nothing
Set ws2 = Nothing
End Sub

お礼

修正ありがとうございます

回答No.2

tsubu-yuki

> こんな感じに作成できないでしょうか？

多分、できますよ。
ただし、他の回答者様のために補足してあげてください。
(1)マクロ（ＶＢＡ）は理解できますか？
(2)シート１～５は同じ作りですか？
　同じなら、複数保持している理由・使い分けの方法も添えて。
(3)半角全角、英字の大文字小文字、撥音拗音などなど区別はしますか？
(4)保存ボタンの場所はどの辺りとお考えですか？
当面、これくらいの情報があれば恐らく作れます。

なお、最も重要な情報は(1)です。

回答No.1

ushi2015

こんにちは
Sub 保存()
　　Dim i As Long
　　Dim j As Worksheet
　　Set j = Worksheets("情報")
　　With ActiveSheet
　　　　If .Name <> j.Name Then
　　　　　　i = WorksheetFunction.CountIfs( _
　　　　　　　　j.Range("B:B"), .Range("A" & Rows.Count).End(xlUp), _
　　　　　　　　j.Range("C:C"), .Range("B" & Rows.Count).End(xlUp))
　　　　　　If i = 0 Then
　　　　　　　　j.Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(, 3).Value = _
　　　　　　　　　　Array(.Name, _
　　　　　　　　　　　　　　.Range("A" & Rows.Count).End(xlUp), _
　　　　　　　　　　　　　　.Range("B" & Rows.Count).End(xlUp))
　　　　　　End If
　　　　End If
　　End With
End Sub
をボタンに登録して実行とか。

お礼

ボタンで
保存できました
ありがとうございます