Results of 1 - 1 of about 469 for EDATE (0.000 sec.)
- [[20081216183241]]
- #score: 9973
- @digest: f4162ee225f7424ed048ac25995ff7c2
- @id: 41336
- @mdate: 2008-12-21T00:04:41Z
- @size: 15562
- @type: text/plain
- #keywords: 配当 (61160), scrollcolumn (31911), dividend (30995), aj35 (24940), sdate (23444), activewindow (19485), smallscroll (18155), iii (15328), 当） (11038), 業員 (9117), ans (8983), tbl (8626), sheet5 (7583), （配 (6583), down (6531), edate (6167), 付曜 (5749), iv (5582), sheet4 (5578), ubound (5384), 日", (4530), ii (4222), 了日 (3201), 始日 (3114), sheets (2859), iif (2724), 。", (2641), inputbox (2319), sheet3 (2312), 2007 (2294), skipblanks (2005), cutcopymode (1912)
- 『Sheet1を基準に各作業員の配当』（配当）
はじめましてよろしくお願いいたします。 Sheet1が原本になります。 A B C D E F AK AL AM 日付 曜日 あ い う え 作業員A 作業員B 作業員C 5 2007/11/1 木 10 11 12 13 ○ ○ ○ 6 2007/11/2 金 10 11 12 13 ○ ○ × 7 2007/11/3 土 10 11 12 13 ○ × × 8 2007/11/4 日 10 11 12 13 × ○ ○ 9 2007/11/5 月 10 11 12 13 × × ○ Sheet2に作業員Aの配当 A B C D E F AK 日付 曜日 あ い う え 作業員A 5 2007/11/1 木 3 3 4 4 ○ 6 2007/11/2 金 5 5 6 6 ○ 7 2007/11/3 土 10 11 12 13 ○ 8 2007/11/4 日 0 0 0 0 × 9 2007/11/5 月 0 0 0 0 × Sheet3に作業員Bの配当 A B C D E F AK 日付 曜日 あ い う え 作業員B 5 2007/11/1 木 3 3 4 4 ○ 6 2007/11/2 金 5 5 6 6 ○ 7 2007/11/3 土 0 0 0 0 × 8 2007/11/4 日 5 5 6 6 ○ 9 2007/11/5 月 0 0 0 0 × Sheet4に作業員Cの配当 A B C D E F AK 日付 曜日 あ い う え 作業員C 5 2007/11/1 木 3 3 4 4 ○ 6 2007/11/2 金 0 0 0 0 × 7 2007/11/3 土 0 0 0 0 × 8 2007/11/4 日 5 5 6 6 ○ 9 2007/11/5 月 10 11 12 13 ○ 上記のようにSheet1を原本としてSheet2,Sheet3,Sheet4へ 各、作業員へ配当分を集計したいのですが可能でしょうか? 割れないであまりが出た場合は切り捨てて（10だとして3人○ならば10÷3で各3 ずつ配当） できればマクロ?でなんて :マクロを実行すると”メッセージボックス”が出てきて 開始の日付は?終わりは?と出てきてその当てはまる日数のみを集計（配当）する何て 出来ればと思い書きました。 (日付は2〜3年分入っています） よろしくお願いいたします。 ---- 無理ではないですかね〜 因みにSheet1をSheet2〜Sheet4に指定した日付のデータをコピーと言う具合でかな? (スガリ） ---- ありがとうございます。やはりそうですか 私は初心者ですがこの学校のやり取りを見ていてエクセルで不可能は あまり無いような気がしまして今回質問しました。（配当） ---- 出来ないことないですよ。 提示された条件で組んでみました。 (ROUGE) '---- Sub Dividend() Dim tbl, ans(), i As Long, ii As Long, n As Integer, x(3 To 6) As Long, iii As Long, ss With Sheets("Sheet1") tbl = .Range("A4", .Range("A" & Rows.Count).End(xlUp)).Resize(, 39).Value End With ReDim ans(1 To UBound(tbl, 1), 1 To 37, 1 To 3) For i = 1 To 3 For ii = 1 To 36 ans(1, ii, i) = tbl(1, ii) Next ans(1, 37, i) = tbl(1, 36 + i) Next For i = 2 To UBound(tbl, 1) n = IIf(tbl(i, 37) = "○", 1, 0) + IIf(tbl(i, 38) = "○", 1, 0) + _ IIf(tbl(i, 39) = "○", 1, 0) For iii = 3 To 6 x(iii) = tbl(i, iii) ¥ n Next For ii = 1 To 3 ans(i, 1, ii) = tbl(i, 1) ans(i, 2, ii) = tbl(i, 2) ans(i, 37, ii) = tbl(i, 36 + ii) For iii = 3 To 6 ans(i, iii, ii) = IIf(ans(i, 37, ii) = "○", x(iii), 0) Next Next Next iii = 0 For Each ss In Array("Sheet2", "Sheet3", "Sheet4") iii = iii + 1 ReDim tbl(1 To UBound(ans, 1), 1 To UBound(ans, 2)) For i = 1 To UBound(tbl, 1) For ii = 1 To UBound(tbl, 2) tbl(i, ii) = ans(i, ii, iii) Next Next With Sheets(ss) .Range("A4", .Range("A" & Rows.Count).End(xlUp)).Resize(, 39).ClearContents .Range("A4").Resize(UBound(tbl, 1), UBound(tbl, 2)).Value = tbl End With Next End Sub ---- (ROUGE)さんありがとうございます。 ビックリで感動しました。 でも一つだけA列の日付の指定をしては無理なのでしょうか? （エラーが出て数字の入っていない部分の日付を消したら出来ました） 説明不足で追加 :マクロを実行すると”メッセージボックス”が出てきて 開始の日付は?終わりは?と出てきてその当てはまる日数のみを集計の事です。 （配当） ---- こんな塩梅でどうでしょうか。 (ROUGE) '---- Sub Dividend() Dim tbl, ans(), i As Long, ii As Long, iii As Long, iv As Long, n As Integer, x(3 To 6) As Long, ss Dim sDate As Date, eDate As Date sDate = Application.InputBox("開始日を指定してください。", "開始日", _ Format(WorksheetFunction.Min(Sheets("Sheet1").Range("A:A")), "yyyy/mm/dd"), Type:=1) eDate = Application.InputBox("終了日を指定してください。", "終了日", _ Format(WorksheetFunction.Max(Sheets("Sheet1").Range("A:A")), "yyyy/mm/dd"), Type:=1) If eDate < sDate Then MsgBox "指定された日付は正しくありません。", vbExclamation, "エラー" Exit Sub End If With Sheets("Sheet1") tbl = .Range("A4", .Range("A" & Rows.Count).End(xlUp)).Resize(, 39).Value End With ReDim ans(1 To UBound(tbl, 1), 1 To 37, 1 To 3) For i = 1 To 3 For ii = 1 To 36 ans(1, ii, i) = tbl(1, ii) Next ans(1, 37, i) = tbl(1, 36 + i) Next iv = 1 For i = 2 To UBound(tbl, 1) If tbl(i, 1) >= sDate And tbl(i, 1) <= eDate Then iv = iv + 1 n = IIf(tbl(i, 37) = "○", 1, 0) + IIf(tbl(i, 38) = "○", 1, 0) + _ IIf(tbl(i, 39) = "○", 1, 0) For iii = 3 To 6 x(iii) = tbl(i, iii) ¥ n Next For ii = 1 To 3 ans(iv, 1, ii) = tbl(i, 1) ans(iv, 2, ii) = tbl(i, 2) ans(iv, 37, ii) = tbl(i, 36 + ii) For iii = 3 To 6 ans(iv, iii, ii) = IIf(ans(iv, 37, ii) = "○", x(iii), 0) Next Next End If Next iii = 0 For Each ss In Array("Sheet2", "Sheet3", "Sheet4") iii = iii + 1 ReDim tbl(1 To UBound(ans, 1), 1 To UBound(ans, 2)) For i = 1 To UBound(tbl, 1) For ii = 1 To UBound(tbl, 2) tbl(i, ii) = ans(i, ii, iii) Next Next With Sheets(ss) .Range("A4", .Range("A" & Rows.Count).End(xlUp)).Resize(, 39).ClearContents .Range("A4").Resize(UBound(tbl, 1), UBound(tbl, 2)).Value = tbl End With Next End Sub ---- (ROUGE)ありがとうございます。 しかし、A〜FまではコピーででるのですがG〜AJまでが 全部コピーされなくて?最初のと比べてみたのですが分からなくて 何度も申し訳ございません（配当） ---- G:AJもなんかあるんですね。。。（当然かwww） (ROUGE) '---- Sub Dividend() Dim tbl, ans(), i As Long, ii As Long, iii As Long, iv As Long, n As Integer, x(3 To 6) As Long, ss Dim sDate As Date, eDate As Date sDate = Application.InputBox("開始日を指定してください。", "開始日", _ Format(WorksheetFunction.Min(Sheets("Sheet1").Range("A:A")), "yyyy/mm/dd"), Type:=1) eDate = Application.InputBox("終了日を指定してください。", "終了日", _ Format(WorksheetFunction.Max(Sheets("Sheet1").Range("A:A")), "yyyy/mm/dd"), Type:=1) If eDate < sDate Then MsgBox "指定された日付は正しくありません。", vbExclamation, "エラー" Exit Sub End If With Sheets("Sheet1") tbl = .Range("A4", .Range("A" & Rows.Count).End(xlUp)).Resize(, 39).Value End With ReDim ans(1 To UBound(tbl, 1), 1 To 37, 1 To 3) For i = 1 To 3 For ii = 1 To 36 ans(1, ii, i) = tbl(1, ii) Next ans(1, 37, i) = tbl(1, 36 + i) Next iv = 1 For i = 2 To UBound(tbl, 1) If tbl(i, 1) >= sDate And tbl(i, 1) <= eDate Then iv = iv + 1 n = IIf(tbl(i, 37) = "○", 1, 0) + IIf(tbl(i, 38) = "○", 1, 0) + _ IIf(tbl(i, 39) = "○", 1, 0) For iii = 3 To 6 x(iii) = tbl(i, iii) ¥ n Next For ii = 1 To 3 ans(iv, 1, ii) = tbl(i, 1) ans(iv, 2, ii) = tbl(i, 2) ans(iv, 37, ii) = tbl(i, 36 + ii) For iii = 3 To 6 ans(iv, iii, ii) = IIf(ans(iv, 37, ii) = "○", x(iii), 0) Next For iii = 7 To 36 ans(iv, iii, ii) = tbl(i, iii) Next Next End If Next iii = 0 For Each ss In Array("Sheet2", "Sheet3", "Sheet4") iii = iii + 1 ReDim tbl(1 To UBound(ans, 1), 1 To UBound(ans, 2)) For i = 1 To UBound(tbl, 1) For ii = 1 To UBound(tbl, 2) tbl(i, ii) = ans(i, ii, iii) Next Next With Sheets(ss) .Range("A4", .Range("A" & Rows.Count).End(xlUp)).Resize(, 39).ClearContents .Range("A4").Resize(UBound(tbl, 1), UBound(tbl, 2)).Value = tbl End With Next End Sub ---- ありがとうございます。 ただコピーと言いましたがコピーではなくて最初に書きました 10だとして3人○ならば10÷3で各3 ずつ配当）なのですが 何度も申し訳ございません。 A〜Fは上記のようになっていて完璧です。（配当） ---- 何度も申し訳ございません。 現在(ROUGE)さんの2回目に教えていただいたマクロでいろいろ 数字を変更して行っているのですがやはりA〜Fまでしか 2回目の式でどこを変更すればSheet2〜Sheet4のA〜AJに 配当がだせるのでしょうか?教えていただけないでしょうか?（配当） ---- おはようございます。 Fは6番目なのでマクロ内の6の部分を（AJは36) と言うことで変えてみましたところ出来ましたが今後なにか問題が 発生するかと心配で、変更部分は下記の三箇所で行いました。 Dim tbl, ans(), i As Long, ii As Long, iii As Long, iv As Long, n As Integer, x(3 To 6) As Long, ss ←（6を36) For iii = 3 To 6 ←（6を36) For iii = 3 To 6 ←（6を36) （配当） ---- こうなったということですよね? F:AJにも数値が入っていたんですね。 何かが分からなかったので、そのまま載せるようにしていました（滝汗 (ROUGE) '---- Sub Dividend() Dim tbl, ans(), i As Long, ii As Long, iii As Long, iv As Long, n As Integer, x(3 To 36) As Long, ss Dim sDate As Date, eDate As Date sDate = Application.InputBox("開始日を指定してください。", "開始日", _ Format(WorksheetFunction.Min(Sheets("Sheet1").Range("A:A")), "yyyy/mm/dd"), Type:=1) eDate = Application.InputBox("終了日を指定してください。", "終了日", _ Format(WorksheetFunction.Max(Sheets("Sheet1").Range("A:A")), "yyyy/mm/dd"), Type:=1) If eDate < sDate Then MsgBox "指定された日付は正しくありません。", vbExclamation, "エラー" Exit Sub End If With Sheets("Sheet1") tbl = .Range("A4", .Range("A" & Rows.Count).End(xlUp)).Resize(, 39).Value End With ReDim ans(1 To UBound(tbl, 1), 1 To 37, 1 To 3) For i = 1 To 3 For ii = 1 To 36 ans(1, ii, i) = tbl(1, ii) Next ans(1, 37, i) = tbl(1, 36 + i) Next iv = 1 For i = 2 To UBound(tbl, 1) If tbl(i, 1) >= sDate And tbl(i, 1) <= eDate Then iv = iv + 1 n = IIf(tbl(i, 37) = "○", 1, 0) + IIf(tbl(i, 38) = "○", 1, 0) + _ IIf(tbl(i, 39) = "○", 1, 0) For iii = 3 To 36 x(iii) = tbl(i, iii) ¥ n Next For ii = 1 To 3 ans(iv, 1, ii) = tbl(i, 1) ans(iv, 2, ii) = tbl(i, 2) ans(iv, 37, ii) = tbl(i, 36 + ii) For iii = 3 To 36 ans(iv, iii, ii) = IIf(ans(iv, 37, ii) = "○", x(iii), 0) Next Next End If Next iii = 0 For Each ss In Array("Sheet2", "Sheet3", "Sheet4") iii = iii + 1 ReDim tbl(1 To UBound(ans, 1), 1 To UBound(ans, 2)) For i = 1 To UBound(tbl, 1) For ii = 1 To UBound(tbl, 2) tbl(i, ii) = ans(i, ii, iii) Next Next With Sheets(ss) .Range("A4", .Range("A" & Rows.Count).End(xlUp)).Resize(, 39).ClearContents .Range("A4").Resize(UBound(tbl, 1), UBound(tbl, 2)).Value = tbl End With Next End Sub ---- ありがとうございます。 変更したのと上記の(ROUGE)さんのを印刷をかけて 重ねて透かして見比べてました。 同じです。何度も何度もありがとうございました。 又、問題が出たらよろしくお願いいたします。（配当） ---- 先日は本当にありがとうございました。 過去の書き込みを見ながら”自動記録”で下記の事を行おうとしたのですが Sheet5に計算式が残ってしまい記録でリンクの貼り付けを行っているから だと思うのですが&実行した時に変な動きがあります。 下記の事を行いたいのですが Sheet2のA5:AJ35を→ Sheet5のA6:AJ36内にコピー Sheet3のA5:AJ35を→ Sheet5のA45:AJ75内にコピー Sheet4のA5:AJ35を→ Sheet5のA84:AJ114内にコピー Sub Macro3() ' ' Macro3 Macro ' ' Sheets("Sheet2").Select ActiveWindow.SmallScroll Down:=-6 Range("A5:AJ35").Select ActiveWindow.ScrollColumn = 7 ActiveWindow.ScrollColumn = 6 ActiveWindow.ScrollColumn = 5 ActiveWindow.ScrollColumn = 4 ActiveWindow.ScrollColumn = 3 ActiveWindow.ScrollColumn = 2 ActiveWindow.ScrollColumn = 1 ActiveWindow.SmallScroll Down:=-15 Application.CutCopyMode = False Selection.Copy Sheets("Sheet5").Select ActiveWindow.SmallScroll Down:=-12 Range("A6").Select ActiveSheet.Paste Link:=True ActiveWindow.SmallScroll Down:=24 Sheets("Sheet3").Select ActiveWindow.SmallScroll Down:=-39 Range("A5:AJ35").Select ActiveWindow.SmallScroll Down:=-18 ActiveWindow.ScrollColumn = 7 ActiveWindow.ScrollColumn = 6 ActiveWindow.ScrollColumn = 5 ActiveWindow.ScrollColumn = 4 ActiveWindow.ScrollColumn = 3 ActiveWindow.ScrollColumn = 2 ActiveWindow.ScrollColumn = 1 ActiveWindow.SmallScroll Down:=15 Application.CutCopyMode = False Selection.Copy Sheets("Sheet5").Select ActiveWindow.SmallScroll Down:=12 Range("A45").Select ActiveSheet.Paste Link:=True ActiveWindow.SmallScroll Down:=30 Sheets("Sheet4").Select ActiveWindow.SmallScroll Down:=-33 Range("A5:AJ35").Select ActiveWindow.SmallScroll Down:=-24 ActiveWindow.ScrollColumn = 10 ActiveWindow.ScrollColumn = 9 ActiveWindow.ScrollColumn = 8 ActiveWindow.ScrollColumn = 7 ActiveWindow.ScrollColumn = 6 ActiveWindow.ScrollColumn = 5 ActiveWindow.ScrollColumn = 4 ActiveWindow.ScrollColumn = 3 ActiveWindow.ScrollColumn = 2 ActiveWindow.ScrollColumn = 1 ActiveWindow.SmallScroll Down:=9 Application.CutCopyMode = False Selection.Copy Sheets("Sheet5").Select ActiveWindow.SmallScroll Down:=15 Range("A84").Select ActiveSheet.Paste Link:=True ActiveWindow.SmallScroll Down:=24 Range("G119").Select End Sub このように記録されました。 よろしくお願いいたします。（配当） ---- 「変な動き」と思われる動きは 具体的にどの様な動きでしょう? 【リンク】貼り付けをしたいのですよね。 (HANA) ---- 画面がチラチラと言うか計算しているみたいです。 リンクと言うのが間違えかもしれません。 Sheet2.Sheet3.Sheet4の指定範囲ないの数字を上記に書きましたSheetに =○○ではなくて値で数字を移行できればなんですが/ ↑実行すると各Sheetの=○○で (Sheet5の罫線等は消さないで、あくまで数字のみを） なんですが説明不足で申し訳ございません。(配当) ---- マクロの記録を録るときは シート間の作業はシートを切り替えて記録します。 セルを選択するときも、実際にそのセルを選択します。 その動きがそのまま記録され プログラムはそれらの切換を瞬く間に行って仕舞うため 画面がちらちらします。 出来たコードから不要部分を削除して Selectしないコードに変更しすれば 画面のちらつきは押さえられると思います。 また、数字のみをコピーしたい場合は 『値貼り付け(V)』で貼り付けてください。 '------ Sub Macro3() Sheets("Sheet2").Range("A5:AJ35").Copy Sheets("Sheet5").Range("A6").PasteSpecial Paste _ :=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets("Sheet3").Range("A5:AJ35").Copy Sheets("Sheet5").Range("A45").PasteSpecial Paste _ :=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets("Sheet4").Range("A5:AJ35").Copy Sheets("Sheet5").Range("A84").PasteSpecial Paste _ :=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False Sheets("Sheet5").Range("G119").Select End Sub '------ (HANA)... - http://www.excel.studio-kazu.jp/wiki/kazuwiki/200812/20081216183241.txt - [detail] - similar
PREV
NEXT
Powered by Hyper Estraier 1.4.13, with 97004 documents and 608067 words.
訪問者：