予約データの入力

質問

エクセルで縦横共に日付が入った表があり、縦は現在、横は２か月先～の日付が入っています。

例えば６月４日に８月３日の予約が３件入った場合、セルＥ７に３と入力します。
ここで、縦で使用するのは当日の行だけなのですが、横には２か月先～の列が並んでおり（半年ほど）、入力する箇所も不規則なので、入力箇所にセルで移動するのを省くために、フォームかシート上の決まった箇所に入力すれば、指定した予約日に件数が入力されるようにしたいと思っています。

ＶＢＡを使用する事になるかと思われますが、私のＶＢＡのレベルが低い物で全く想像つきません。
（私のレベルはネット等で検索して見つけたコードを自分用に置き換えて使っている程度で、自作は本当に簡単なものしか出来ません。）

一応分かりにくいかもしれませんがイメージの画像を添付しておきます。

上が表で、下にあるのが入力部分になっています。
現在日付は=TODAY()で出力し、予約日・件数は毎回入力、移行ボタンを押せば上の表に飛ぶといった具合です。

よろしくお願いいたします。

回答No.2

tom04 · ベストアンサー

こんばんは！

質問では
＞例えば６月４日に８月３日の予約が３件入った場合、
とありますが、6月4日とはTODAY()関数が入っている日付になるのが一般的な考え方ではないでしょうか？

そこで余計なお世話かもしれませんが、表のレイアウトを変えてみました。
↓の画像で説明させていただくと・・・

通常A列は「受付日」となり、列方向に「予約日」になると思います。
日付に関してはシリアル値の方が都合が良いので、
A6セル（セルの表示形式はユーザー定義から　m/d(aaa)　としておきます）に表示したい最初の日付を入力し
オートフィルでずぃ～～～！っと下へコピー！

列方向の同様（セルの表示形式を含め）に
B5セルに表示したい最初の日付を入力　→　列方向にオートフィルでコピー！

以上の下準備ができた上での一例です。

画像ではコマンドボタンを挿入　→　コマンドボタンのコードを

Private Sub CommandButton1_Click()
Dim i As Long, j As Long
If Range("B2") = "" Then
MsgBox "予約日が未入力です"
Range("B2").Select
Exit Sub
ElseIf Range("B3") = "" Then
MsgBox "獲得件数が未入力です"
Range("B3").Select
Exit Sub
End If
i = WorksheetFunction.Match(Range("B1"), Range("A:A"), False)
j = WorksheetFunction.Match(Range("B2"), Range("5:5"), False)
Cells(i, j).Select
Selection = Range("B3")
End Sub

としています。

これでB1には
=TODAY()
と関数を入れておき、B2・B3セルを入力　→　コマンドボタンをクリック
これで何とかご希望に近い形にならないでしょうか？m(_ _)m

この投稿のマルチメディアは削除されているためご覧いただけません。

お礼

tom04様、回答ありがとうございます。
お礼が遅くなり申し訳ありません。

私がこんな感じでできないかな～と思っていたのが正にこちらです。
受付日は基本当日なんですが、ごく稀に遡る事があるため（入力忘れです・・・）直接日付を入力する事があります。
ですので、ワークシートを開くと、セルB1に=TODAY()関数を入力するようなマクロを組んでみます。

tom04さんのコードはこれから1行ずつ解読し勉強してみます。
ありがとうございました。

補足

少しアレンジしまして下記のコードでうまく起動できました。
コマンドボタンだとマウスに持ち替えないといけないので、Worksheet_changeをつかってB3のセルに入力後、Enterを押すと起動し、B1に戻り=TODAY()を入れるといった風にしました。
ありがとうございました。

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Address = "$B$3" Then

Dim i As Long
Dim j As Long

If Range("b2") = "" Then
MsgBox "予約日が未入力です"
Range("b2").Select
Exit Sub
ElseIf Range("b3") = "" Then
MsgBox "件数が未入力です"
Range("b3").Select
Exit Sub
End If

i = WorksheetFunction.Match(Range("B1"), Range("A:A"), False)
j = WorksheetFunction.Match(Range("B2"), Range("6:6"), False)

Cells(i, j).Select
Selection = Range("b3")

Range("b1").Select
Range("b1").Value = "=today()"

End If

End Sub

回答No.5

noname#215107

No.1です。

VBAを使うのはいいのですが、小規模中規模にかかわらず、メンテナンス性を考慮しなければなりません。他の人がそのVBAのコードを変更したい場合に、分かりやすくするための配慮をして設計できますか？
プログラミングの経験がある人は、それなりの作法を知っています。

それができなければ不用意にVBAを使わないほうがいいでしょう。

ピボットテーブルだけで作ってみました。
あくまでも一例です。

この投稿のマルチメディアは削除されているためご覧いただけません。

回答No.4

KURUMITO

お示しの予約状況の表ですが右横方向に8月からの日付が、縦方向には予約日が入力されお互いの日の交わる位置に予約の件数を入力する表となっています。非常に見づらく利用しにくい表となっています。
エクセルの特徴を活かすには入力された日付の順にデータが下方に並んでいくようにすることでしょう。入力の実績を時系列で分かるようにしておくことでしょう。
マクロによる入力ではしばしば時系列などで記録に残るといったことはなくなりますね。出来るだけ関数などを使って対応することでしょう。例えば次のようにすることでしょう。
入力の基礎データをシート1に入力し、シート2ではお求めのようなデータを見やすい形で表示するようにします。
例えばシート1ではつぎのようにします。
Ａ1セルに日付、Ｂ1セルに曜日、Ｃ1セルに予約者名、Ｄ1セルに予約日、Ｅ1セルに当日獲得数、Ｆ1セルに前日までの獲得総数、Ｇ1セルに当日までの獲得総数、Ｈ1セルは空のままでＩ1セルには作業列とそれぞれ項目名を入力します。
Ａ列からＢ列を除いたＥ列までについては2行目以降にデータを入力していきます。
Ｂ２セルには次の式を入力して下方にドラッグコピーします。

=IF(A2="","",TEXT(A2,"aaa"))

Ｆ２セルには次の式を入力して下方にドラッグコピーします。

=IF(D2="","",SUMIF(D$1:D1,D2,E$1:E1))

Ｇ２セルには次の式を入力して下方にドラッグコピーします。

=IF(D2="","",E2+F2)

Ｉ2セルには次の式を入力して下方にドラッグコピーします。

=IF(D2="","",D2&"/"&COUNTIF(D$2:D2,D2))

以上でシート１での作業は終わります。
シート2ではＡ1セルに予約状況の文字を、Ａ2セルには日付、Ｂ2セルには曜日、Ｃ2セルには総獲得数、Ｄ2セルには予約の状況とそれぞれ項目名を入力します。
Ａ3セルから下方には例えば8月1日からの日付を入力します。
Ｂ３セルには次の式を入力して下方にドラッグコピーします。

=IF(A3="","",TEXT(A3,"aaa"))

Ｃ３セルには次の式を入力して下方にドラッグコピーします。

=IF(SUMIF(Sheet1!D:D,A3,Sheet1!E:E)=0,"",SUMIF(Sheet1!D:D,A3,Sheet1!E:E))

Ｄ３セルには次の式を入力して右横方向にドラッグコピーしたのちに下方にもドラッグコピーします。

=IF(C3="","",IF(COUNTIF(Sheet1!$I:$I,$A3&"/"&COLUMN(A1))=0,"",TEXT(INDEX(Sheet1!$A:$A,MATCH($A3&"/"&COLUMN(A1),Sheet1!$I:$I,0)),"m月d日")&"/"&INDEX(Sheet1!$E:$E,MATCH($A3&"/"&COLUMN(A1),Sheet1!$I:$I,0))))

Ｄ列には例えば６月３日に８月４日５件の申し込みが有った場合にはＡ列の８月４日の行の位置に６月３日/５のように表示されます。後日６月６日に３件の申し込みが有った場合にはＥ列の同じ行に６月６日/3のように表示されます。
お示しの表のような場合には離れたセルにそれらが表示されることになってしかも上の日付と、左端の日付を見なければわからないということになりますね。

以上のような表になりますが関数での表示では一度式を入力してあれば後は自動的に表示されますのでデータ入力操作ボタンなどをクリックすることも必要なくどなたでも対応できることになりますね。
長々と説明しましたが一度是非試してみてください。参考になりましたら幸いです。

お礼

KURUMITO様、回答ありがとうございます。
お礼が遅くなりすみません。

現在の表が私が作ったものではなく、そのまま引き継いだので、そのままどうにか出来ないかと思っていましたが、KURUMITOさんの式による表もかなり使い勝手よく作れそうですね。

これは少し表そのものを見直してもいいかもしれません。
現状だと縦はいいとして横に長すぎるのが結構面倒ですので・・・

大変参考になりました。
ありがとうございました。

回答No.3

keithin

ちなみにそういうお仕事だと、記入した獲得件数は、現在までの予約件数に「加算される」という説明がヌケてるんじゃないでしょうか。
それともホントに更新し（書き換え）ちゃっていいんでしょうか？

＃余談
＞横には２か月先～の列が並んでおり（半年ほど）

というお話だと、あなたが用意したサンプルの画像でそこに「８月」が記入されてたら変ですね。

本題。
Ｃ２セルに「8/1」と記入、右向けに半年ほどオートフィルドラッグ
Ｃ３セルに　=C2　と記入、右向けにオートフィルドラッグ
Ａ４セルに「6/1」と記入、下向けにてきとーにオートフィルドラッグ
Ｂ４セルに　=A4　と記入、下向けにオートフィルドラッグ
それぞれセルの書式設定の表示形式で適切に表示を調整する

ちなみに１０行目からデータ入力してしまうと６／１以下とばっちし重なっちゃいますが、まぁそのぐらいは自力で修正してもらうことにして。

手順：
ＡＬＴ＋Ｆ１１を押してＶＢＥ画面を出す
挿入メニューから標準モジュールを挿入する
現れたシートに下記をコピー貼り付ける

sub macro1()
　dim r as long
　dim c as long
　on error goto errhandle

　r = application.match(range("C11"), range("A:A"), 0)
　c = application.match(range("C12"), range("2:2"), 0)
　cells(r, c).value = cells(r, c).value + range("C13").value
’オプション：マクロを使う方法では、誤操作で「うっかりもう一回クリック/あれ今クリックしたかな？まだだっけ？」を予防できません
　cells(r, c).clearcontents
　exit sub

errhandle:
　msgbox "日付がありません"
end sub

ファイルメニューから終了してエクセルに戻る
シート上にオートシェイプとかテキストの追加とかで「データ移行ボタン」を準備、右クリックしてマクロの登録する。

お礼

keithin様、回答有難うございます。
お礼が遅れましてすみません。

予約件数の加算（縦の合計）はずっと下の方で行っているので大丈夫です。
あくまで当日に受けた予約件数を入力する表になっております。

コードの記述、ありがとうございます。
こん感じでと思っていたように入力できました。
application.matchは使った事がなかったので、この期会に勉強しておきます。

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

回答No.1

noname#215107

面倒くさい設計をしましたね。

データ形式は以下のようにしたらいいと思います。（あくまでも例ですよ！）

csv形式で保存
"受付日","予約日"
"6/1/2013" , "8/1/2013"
"6/1/2013" , "8/2/2013"
"6/1/2013" , "8/3/2013"
"6/2/2013" , "8/1/2013"
"6/3/2013" , "8/3/2013"
"6/4/2013" , "8/5/2013"
この順番ではなくても、データの発生した順番で良いです。

これを入力する順番は、VBAやフォームを利用して順不同に入力すればいいです。

最後に表を作りたいときに、ピボットテーブル等で、添付なさった画像のような表にしましょう。

つまり、入力するときのスタイルと、完成した出力のスタイルは別に考えましょうということです。

お礼

TXV12003様、回答ありがとうございます。
お礼が遅くなりすみません。

元々私が作った表ではないのですが、面倒な設計になっております。

ご指摘下さったピボットテーブル、あまり使ったことが無かったのですが、試してみたらかなり簡単に縦横の表示が出来ました。
実際の表に適応出来るかやってみます。
ありがとうございました。