[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『表から入力されてるセルの日付を反映』（ごま塩）
エクセルで作成している用紙が有ります。
用紙はA列からAT列まで有り、枠外のAVからCAまで１ヶ月分の開始と終了の表が有ります。
用紙の構成は、A14、A16に月、行は同じでC列に日付、E14に開始、E16に終了が入ります。
これが一回分で、同じ構成で六回分有ります。セルでいうと
行14、16
17、19
20、22
23、25
26、28
29、31
となります。
表の構成です。日付はシリアル値で2018/10/1です。
AV AW AX AY AZ･･･CA
1 日付 1 2 3 4･･･31
2 曜日 月 火 水 木･･･水
3 開始 A A
4 終了 B B
上の表の場合、用紙のA14とA16に月の10、C14に日付の1、C16に3、E14に開始のA、E16に終了のB、
同じようにA17、A19に10、C17に3、C19に4、E17にA、E19にBと入れたいのですが方法がさっぱり分かりません。
やりたいことをまとめますと、
1)表を一週間区切りで区別(一週間は月から日曜日)し、日付の順に上から用紙に反映させる。
2)一週間の範囲に入力されている値を指定のセルに反映。
3)日曜日に開始の値がある時は、次の終了(B)まで表示する。
3番目についてですが、
AV AA AB AC AD
1 日付 5 6 7 8
2 曜日 金 土 日 月
3 開始 A
4 終了 B
この場合ですと、日曜で終わっているので用紙の反映は7日までですが、
AV AA AB AC AD
1 日付 5 6 7 8
2 曜日 金 土 日 月
3 開始 A
4 終了 B
この場合は日曜から始まっているので、終わりが8日の月曜になります。(終わりは月曜以外のことも有ります)
開始のA、7日で切らない、ということになります。
果たしてエクセルで可能なのか分かりませんが、ご教授お願いします。
説明不足でしたら指摘お願いします。
＜ 使用 Excel：Excel2010、使用 OS：Windows7 ＞
＞用紙はA列からAT列まで有り、
・・と言う割には、A列からE列までの話しか出てこないんですけど、 それは単なる参考情報として書いただけで、問題はA,C,E列限定と理解していいんですか？
A列に「月だけ」、C列に「日だけ」と言う表らしいのですが、 どっちか一つの列に「年月日(シリアル値）」とする訳には行かないですか？ (同じような数式を二通りも書くのは面倒ですし、「年」情報が無いのはミスの元なので）
（半平太） 2018/10/06(土) 20:42
･問題はA,C,E列限定と理解していいんですか？
分かり難くてすみません、その通りです。
･どっちか一つの列に「年月日(シリアル値）」とする訳には行かないですか？
正直、その方法は思い浮かばなかったです。最初から月日のセルが別々でしたので、そういうものだと思考停止していました。一つのセルで大丈夫です。
不明点があれば指摘お願いします。
（ごま塩） 2018/10/06(土) 20:59
月をまたぐ場合についても抜けていました。
またぐ場合は単純に表の隣に次の表を張り付ける形にして地続きにしようと思っています。
不明点があれば指摘お願いします。
（ごま塩） 2018/10/06(土) 22:23
＞開始はA、終了はBと書きましたが便宜的なもので、開始には2種類、種類は5種類あります。
あのー、条件を後出ししないようにお願いします。二度手間は避けたいので。
開始はA,C 、終了はB,D,Eだと仮定します。
開始と終了の対応関係が分からないので、出現する順とします。
(1) A14セル =INDEX(AW1:BC1,MATCH(1,INDEX(WEEKDAY($AW$1:$BC$1,2),0),0)) ↑ ※これは何処にもコピーしない数式
(2) A16セル =IF(A14="","",(AGGREGATE(15,6,$AW$1:$CA$1/(($AW$4:$CA$4={"B";"D";"E"})*($AW$1:$CA$1>=$A$14)),(ROW(A1)+2)/3)))
(3) A17セル =IFERROR(AGGREGATE(15,6,$AW$1:$CA$1/(($AW$3:$CA$3={"A";"C"})*($AW$1:$CA$1<=$A$14+7)),(ROW(A4)+2)/3),"")
A16:A18の3つのセル(下の空白セルを含む）を一括選択して、丸ごと31行目までフィルコピー
(4) E14セル =IF(A14="","",HLOOKUP(A14,$AW$1:$CA$3,3,FALSE)) (5) E16セル =IF(A16="","",HLOOKUP(A16,$AW$1:$CA$4,4,FALSE))
E14:E16の3つのセル(中に１つ空白セルを含む)を一括選択して、丸ごと31行目までフィルコピー
<サンプル> 行 _AV_ ___AW___ ___AX___ ___AY___ ___AZ___ ___BA___ ___BB___ ___BC___ ___BD___ ___BE___ 1 日付 10月1日 10月2日 10月3日 10月4日 10月5日 10月6日 10月7日 10月8日 10月9日 2 曜日 月 火 水 木 金 土 日 月 火 3 開始 A A C A 4 終了 B B E D
<結果図> 行 ____A____ _B_ _C_ _D_ _E_ 14 2018/10/1 A 15 16 2018/10/3 B 17 2018/10/3 A 18 19 2018/10/4 B 20 2018/10/6 C 21 22 2018/10/7 E 23 2018/10/7 A 24 25 2018/10/9 D
（半平太） 2018/10/06(土) 23:17
A14に入れる数式を入力すると１日が入り、正しい結果が得られましたが、１日にA、Cが入っていない場合は空白になります。match関数の部分の数字をその日付に変えると大丈夫なのですが、一週間という範囲もずれてしまいます。
用紙は複数人が使用するので、一人一人日付を変える手間はなくしたいです。
わがままを言ってすみません、、、
（ごま塩） 2018/10/07(日) 10:04
＞１日にA、Cが入っていない場合は空白になります。
済みませーん。A14セルとA17の数式を以下に変えてください。
A14セル =IFERROR(AGGREGATE(15,6,$AW$1:$CA$1/($AW$3:$CA$3={"A";"C"}),1),"")
A17セル =IFERROR(AGGREGATE(15,6,$AW$1:$CA$1/(($AW$3:$CA$3={"A";"C"})*($AW$1:$CA$1<=$A$14-WEEKDAY($A$14,2)+7)),(ROW(A4)+2)/3),"")
（半平太） 2018/10/07(日) 11:25
最後に、一つ宜しいでしょうか。
今まで手作業で日付を入れていたので、入力されたら行の下に以下余白と表示するマクロを使ってました。掲示板で見つけた[[20040528113859]]これをA列に入力したらM列に、というふうに改良してです。
やはりと言いますか、数式が入っていると動かないんですね。
数式が入っても、Aがでたら、Cがでたら以下余白は可能でしょうか？
新規作成した方が良い場合は言ってください。
もし可能でしたら、以下余白の両サイドに図形の横棒等で行に線を引くことも出来ますか？
（ごま塩） 2018/10/07(日) 12:24
ちょっと、どう言うことか分からないです。
その改良したマクロとやらをアップしてもらえませんか？
（半平太） 2018/10/07(日) 14:43
Private Sub Worksheet_Change(ByVal Target As Range)
If (Target.Count > 1) + (Target.Column <> Range("b:b").Column) Then Exit Sub
With Range("b65536").End(xlUp)
If .Value = "以下余白" Then Exit Sub
.Offset(1, 0).Value = "以下余白"
End With
End Sub
以前はm列に部署を入力する欄が有り、なのでRange("b:b")とRange("b65536")のレンジオブジェクトをmに変えて、入力した行の下に以下余白が出るようにしていました。
以下余白の行以下は使用できないことを示すために、以下余白の両サイドに行の真ん中に線を引く必要があるのですが、それは手作業でやっています。
現在はA列の月日しか必ず入力するセルがないため、A列に月日が入力されたらその下のM列に以下余白と横線を入れたいと思っています。
（ごま塩） 2018/10/07(日) 15:59
M列には「以下余白」しかデータがないのですか？
もし有ったら、それが「以下余白」に上書きされちゃうのでまずいですよね？
無ければ、初めにM列をクリアーしてから、 「A行のデータ最下行」の一つ下の行のM列に「以下余白」と入れればいいだけになると思うんですが、 それでいいんですか？
但し、こんどは何か入力する訳じゃないので、トリガーとしてはChangeイベントは使えないです。 マクロ実行させる何かが必要です。(通常は実行ボタンを作って、それをクリック）
＞余白の両サイドに図形の横棒等で行に線を引くことも出来ますか？
両サイドとはどこからどこまで、どんな長さの線が何本あるのか分からないです。
まぁ、既に在るんでしょうから、それを移動させればいいだけだとは思いますけど。。
因みに、その線のオブジェクトNameは何ですか？ それが分からないと当該オブジェクトが取得できないです。
試しに手で書いたものだと、こんなNameになっていましたけども。。 ↓ "Straight Connector 2"
（半平太） 2018/10/07(日) 17:54
それでいいんですか？
それで大丈夫です。
〉因みに、その線のオブジェクトNameは何ですか？
すみません、オブジェクトname取得でネット調べましたが、コード書いても反応しないです。
取得方法を教えて貰えないでしょうか。
試したのは下のコードです。
Sub 選択図形の名前を取得する()
Dim shp As Shape
On Error GoTo ERR_HNDL
For Each shp In Selection.ShapeRange
Debug.Print shp.Name
Next shp
Exit Sub
ERR_HNDL:
MsgBox "図形が選択されていません。"
End Sub
（ごま塩） 2018/10/07(日) 18:27
図形の線があるシートをアクティブにして 以下のマクロを実行してください。
Sub 選択図形の名前を取得する()
Dim shp As Shape
For Each shp In ActiveSheet.Shapes
Debug.Print shp.Name
Next shp
End Sub
その結果として、イメディエイトウィンドウに出た名前をここにアップしてください。
（半平太） 2018/10/07(日) 19:27
オブジェクトnameは半平太さんと同じ、Straight Connector 2 になりました。通常の横線です。
（ごま塩） 2018/10/07(日) 20:10
＞Straight Connector 2 になりました。
一本だけだったんですか？(両サイドだから、最低２本はあるかと思ってました）
Sub 以下余白()
Const WsName As String = "Sheet1" ' ←実際のシート名に変更する
Dim Ws As Worksheet
Dim cel As Range
Set Ws = Sheets(WsName)
Ws.Columns("M").ClearContents ’事前クリア
Set cel = Ws.Columns("A:A").Find("*?", Ws.Range("A1"), xlValues, xlPart, , xlPrevious)
With cel.EntireRow.Range("M1").Offset(1) '書込むセル(最下行の一つ下）
.Value = "以下余白"
Ws.Shapes("Straight Connector 2").Top = .Top + .Height / 2
End With
End Sub
（半平太） 2018/10/07(日) 20:20
＞一本だけだったんですか？(両サイドだから、最低２本はあるかと思ってました）
すみません、2本です。
Straight Connector 2 とStraight Connector 3でした。
上のマクロを入れてみましたが、反応がないです。
別の新規ブックで動かすと、オブジェクト変数またはWithブロック変数が設定されていません、と出ます。
ご教授お願いします。
（ごま塩） 2018/10/07(日) 21:14
そう言われましても、そちらの図形線とやらが実際にどうなっているのか分からないですからねぇ。
いままでチャンと引けていた線なら、チャンと移動すると思うんですが。。
いままで通り、チャンと引かれている状態にしてから、実行してみてください。
ところで「以下余白」は正しく出たですか？
「何も反応しない」とはそれさえ出ないと言う事ですか？
（半平太） 2018/10/07(日) 21:28
ただ、今回は実行時エラー1004というのが出ます。
また明日やり直してみます。
ありがとうございました。
（ごま塩） 2018/10/07(日) 21:43
＞二本目の線、Straight Connector 3を動かすにはどうすれば良いでしょうか。
２本しかないので、同じようにもう一行書くだけです。
＞ With cel.EntireRow.Range("M1").Offset(1) '書込むセル(最下行の一つ下）
＞ .Value = "以下余白"
＞ Ws.Shapes("Straight Connector 2").Top = .Top + .Height / 2
＞ End With
↑そこの部分を一行追加
With cel.EntireRow.Range("M1").Offset(1) '書込むセル(最下行の一つ下）
.Value = "以下余白"
Ws.Shapes("Straight Connector 2").Top = .Top + .Height / 2
Ws.Shapes("Straight Connector 3").Top = .Top + .Height / 2 '←一行追加
End With
（半平太） 2018/10/08(月) 08:35
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.