Results of 1 - 1 of about 33537 for 関数 (0.006 sec.)
- [[20240514191811]]
- #score: 2646
- @digest: 1f3e57330960430dea9badbda8b8df4f
- @id: 96726
- @mdate: 2024-05-16T10:35:41Z
- @size: 17647
- @type: text/plain
- #keywords: remainingseats (160245), schedule (121097), 残席 (94485), 選日 (72702), 望ws (69740), 各参 (61091), 当選 (45724), 望" (41443), 席数 (37260), 望人 (36067), 選者 (32812), 者当 (31932), 望日 (31494), 加者 (30945), トsc (29295), 望第 (27342), 施日 (25598), 日程 (20232), ） ws (17906), 先度 (17175), 参加 (16925), 所" (14366), 希望 (11910), 第3 (11404), 第1 (9360), 第2 (8005), 実施 (7329), 号" (7256), rnd (5403), 人数 (5253), 定se (5060), 住所 (4774)
- 『先着30名のカウントと当選日を出したい』（たー）
受付番号 名前 住所 希望人数 第1希望 第2希望 第3希望 当選日 1 あおもり 5 6/1?@ 6/3?@ 6/5?A 6/1?@ 2 いわて 2 6/1?A 6/3?A 6/5?@ 3 ふくしま 6 6/1?@ 6/3?@ 6/5?A 番号は、180までです。 ※名前と住所の間に、年齢が来るかもしれないです。 たたき台として、このような表があります。 日程は、3日間。午前と午後があるので?@と?Aで分けます。 やりたいこととしては、先着30名で合計180名募集をかけます。 その時、6/1?@の希望人数があと何人なのかがすぐ把握したいです。 また、6/1?@が30名埋まった場合当選日を表示出来るようにしたいです。 受け付け番号が、上の達は第1希望で決まりますが下にいくにつれて 第2希望、第3希望となってきます。 どうにか自動でやりたいと思っています。 足りない作業列は、追加可能です。 これが、叶う関数を教えてください。 実際、募集が始まるのは20日からです。 ＜ 使用 Excel:Microsoft365、使用 OS:Windows11 ＞ ---- Sub AssignSchedule() Dim ws As Worksheet Dim lastRow As Long, i As Long, j As Long Dim schedule As Variant Dim remainingSeats As Integer ' 希望日程のリスト schedule = Array("6/1?@", "6/1?A", "6/3?@", "6/3?A", "6/5?@", "6/5?A") ' ワークシートを指定 Set ws = ThisWorkbook.Sheets("Sheet1") ' シート名を適切なものに変更 ' 最終行を取得 lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row ' 残席数の計算 remainingSeats = 30 ' 各日程に対して参加者を割り当てる For j = LBound(schedule) To UBound(schedule) For i = 2 To lastRow If ws.Cells(i, "F").Value = schedule(j) Or ws.Cells(i, "G").Value = schedule(j) Or ws.Cells(i, "H").Value = schedule(j) Then ' 参加者が希望日程に参加希望の場合 If remainingSeats > 0 Then ' 残席がある場合は参加者を割り当て、残席数を減らす ws.Cells(i, "I").Value = schedule(j) remainingSeats = remainingSeats - 1 Else ' 残席がない場合は次の日程に進む Exit For End If End If Next i Next j ' 最終的にどの日程に割り当てたかを表示 For j = LBound(schedule) To UBound(schedule) If WorksheetFunction.CountIf(ws.Columns("I"), schedule(j)) < 30 Then ws.Range("L2").Value = schedule(j) Exit For End If Next j ' 残席数を表示 For j = LBound(schedule) To UBound(schedule) remainingSeats = 30 - WorksheetFunction.CountIf(ws.Columns("I"), schedule(j)) ws.Cells(2, 10 + j).Value = remainingSeats Next j End Sub 番号,名前,年齢,住所,参加人数,第1希望,第2希望,第3希望,当選日 1,田中,30,東京,1,6/1?@,6/3?@,6/5?@, 2,山田,25,大阪,1,6/3?@,6/1?@,6/5?@, 3,佐藤,35,名古屋,1,6/1?@,6/5?@,6/3?@, 4,鈴木,40,福岡,1,6/5?@,6/3?@,6/1?@, 5,高橋,28,札幌,1,6/1?@,6/3?@,6/5?@, （通勤中の通りすがり） 2024/05/14(火) 23:43:39 ---- 以下は、コピペで使用できる状態での式です。まず、各参加者の希望日程ごとに優先度を割り当てる式です: =IF(COUNTIF($F2:$H2, "6/1?@")>0, 3, IF(COUNTIF($F2:$H2, "6/1?A")>0, 2, IF(COUNTIF($F2:$H2, "6/3?@")>0, 1, IF(COUNTIF($F2:$H2, "6/3?A")>0, 1, IF(COUNTIF($F2:$H2, "6/5?@")>0, 1, IF(COUNTIF($F2:$H2, "6/5?A")>0, 1, 0))))))) 次に、各参加者の希望日程の中で優先度が最大である日程を選択する式です: =IF(B2=MAX($B$2:$B$31), INDEX($F$1:$H$1, MATCH(MAX($B$2:$B$31), $B$2:$B$31, 0)), "") に、参照するセルの範囲や位置を指します。 最初の式（優先度を割り当てる式）を使用する場合: 各参加者ごとに、希望日程が記録されているセル範囲を指定します。例えば、第1希望がF列、第2希望がG列、第3希望がH列などです。この場合、各参加者の希望日程が記録されているセル範囲は、F2:H31 のようになります。 この式は、各参加者ごとに計算されるため、各参加者のデータが格納されている行に適用される必要があります。 2番目の式（最初に参加可能な日程を選択する式）を使用する場合: 各参加者の優先度が記録されているセル範囲を指定します。例えば、優先度が記録されているセル範囲は、B2:B31 のようになります。 各参加者の希望日程が記録されているセル範囲（第1希望、第2希望、第3希望が記録されている列）も指定します。例えば、第1希望がF列、第2希望がG列、第3希望がH列などです。この場合、各参加者の希望日程が記録されているセル範囲は、F1:H1 のようになります。 この式は、各参加者の優先度を計算するために使用されます。そのため、優先度が計算される範囲は、各参加者のデータが格納されている行に合わせる必要があります。 （通りすがり） 2024/05/14(火) 23:56:10 ---- 日程を選択する式です: =IF(B2=MAX($B$2:$B$31), INDEX($F$1:$H$1, MATCH(MAX($B$2:$B$31), $B$2:$B$31, 0)), "") これらの式を適切なセルにコピー&ペーストして使用すると、各参加者の当選日を計算することができます。 （通りすがり） 2024/05/14(火) 23:58:57 ---- =IF(COUNTIF($F2:$H2, "6/1?@")<=30, 3, IF(COUNTIF($F2:$H2, "6/1?A")<=30, 2, IF(COUNTIF($F2:$H2, "6/3?@")<=30, 1, IF(COUNTIF($F2:$H2, "6/3?A")<=30, 1, IF(COUNTIF($F2:$H2, "6/5?@")<=30, 1, IF(COUNTIF($F2:$H2, "6/5?A")<=30, 1, 0))))))) （通りすがり） 2024/05/15(水) 00:53:06 ---- 上記の式を、B列に書きます =IF(B2=MAX($B$2:$B$31), INDEX($F$1:$H$1, MATCH(MAX($B$2:$B$31), $B$2:$B$31, 0)), "") を、当選日欄にコピペ （通りすがり） 2024/05/15(水) 01:07:43 ---- =IF(AND($C2<=8, COUNTIF($D2:$F2, "6/1?@")<=30), DATE(YEAR(TODAY()), MONTH($G2), DAY($G2)), IF(AND($C2<=8, COUNTIF($D2:$F2, "6/1?A")<=30), DATE(YEAR(TODAY()), MONTH($G2), DAY($G2)), IF(AND($C2<=8, COUNTIF($D2:$F2, "6/3?@")<=30), DATE(YEAR(TODAY()), MONTH($G2), DAY($G2)), IF(AND($C2<=8, COUNTIF($D2:$F2, "6/3?A")<=30), DATE(YEAR(TODAY()), MONTH($G2), DAY($G2)), IF(AND($C2<=8, COUNTIF($D2:$F2, "6/5?@")<=30), DATE(YEAR(TODAY()), MONTH($G2), DAY($G2)), IF(AND($C2<=8, COUNTIF($D2:$F2, "6/5?A")<=30), DATE(YEAR(TODAY()), MONTH($G2), DAY($G2)), "未当選")))))) （通りすがり） 2024/05/15(水) 01:30:53 ---- | 番号 | 名前 | 年齢 | 住所 | 電話番号 | 第1希望 | 第2希望 | 第3希望 | 当選日 | 人数 | |------|----------|------|--------|--------------|----------|----------|----------|----------|------| | 1 | 参加者1 | 35 | 住所1 | 0801234567 | 6/1?A | 6/1?A | 6/5?@ | | 4 | | 2 | 参加者2 | 45 | 住所2 | 0802345678 | 6/1?A | 6/3?A | 6/5?@ | | 6 | | 3 | 参加者3 | 28 | 住所3 | 0803456789 | 6/1?@ | 6/5?@ | 6/5?@ | | 2 | | ... | ... | ... | ... | ... | ... | ... | ... | ... | ... | （通りすがり） 2024/05/15(水) 08:20:08 ---- Sub GenerateSampleData() Dim ws As Worksheet Dim i As Long Dim schedule As Variant Dim fileName As String Dim remainingSeats As Integer ' 希望日程のリスト schedule = Array("6/1?@", "6/1?A", "6/3?@", "6/3?A", "6/5?@", "6/5?A") ' ワークシートを指定 Set ws = ThisWorkbook.Sheets("Sheet1") ' シート名を適切なものに変更 ' データをクリア ws.Cells.Clear ' ヘッダー行の設定 ws.Cells(1, 1).Value = "番号" ws.Cells(1, 2).Value = "名前" ws.Cells(1, 3).Value = "年齢" ws.Cells(1, 4).Value = "住所" ws.Cells(1, 5).Value = "電話番号" ws.Cells(1, 6).Value = "第1希望" ws.Cells(1, 7).Value = "第2希望" ws.Cells(1, 8).Value = "第3希望" ws.Cells(1, 9).Value = "当選日" ws.Cells(1, 10).Value = "人数" ' 残席数の初期化 remainingSeats = 8 ' 各行にデータを入力 For i = 1 To 50 ' 番号 ws.Cells(i + 1, 1).Value = i ' 名前 ws.Cells(i + 1, 2).Value = "参加者" & i ' 年齢（20歳から50歳の間でランダム） ws.Cells(i + 1, 3).Value = Int((50 - 20 + 1) * Rnd + 20) ' 住所 ws.Cells(i + 1, 4).Value = "住所" & i ' 電話番号（仮の番号を生成） ws.Cells(i + 1, 5).Value = "080" & Int((9999 - 1000 + 1) * Rnd + 1000) & Int((9999 - 1000 + 1) * Rnd + 1000) ' 第1希望 ws.Cells(i + 1, 6).Value = schedule(Int((UBound(schedule) + 1) * Rnd)) ' 第2希望 ws.Cells(i + 1, 7).Value = schedule(Int((UBound(schedule) + 1) * Rnd)) ' 第3希望 ws.Cells(i + 1, 8).Value = schedule(Int((UBound(schedule) + 1) * Rnd)) ' 当選日は空欄で初期化 ws.Cells(i + 1, 9).Value = "" ' 人数（1から残席数までのランダムな整数） ws.Cells(i + 1, 10).Value = Int(remainingSeats * Rnd) + 1 ' 残席数を更新 remainingSeats = remainingSeats - ws.Cells(i + 1, 10).Value If remainingSeats <= 0 Then remainingSeats = 8 End If Next i ' ファイル名の設定 fileName = ThisWorkbook.Path & "¥sample_data.csv" ' CSVファイルとして保存 ws.SaveAs fileName, xlCSV ' メッセージを表示 MsgBox "サンプルデータが生成されました:" & fileName, vbInformation End Sub （通りすがり） 2024/05/15(水) 09:32:38 ---- Sub GenerateSampleData() Dim ws As Worksheet Dim i As Long Dim schedule As Variant Dim fileName As String Dim remainingSeats As Integer ' 希望日程のリスト schedule = Array("6/1?@", "6/1?A", "6/3?@", "6/3?A", "6/5?@", "6/5?A") ' ワークシートを指定 Set ws = ThisWorkbook.Sheets("Sheet1") ' シート名を適切なものに変更 ' データをクリア ws.Cells.Clear ' ヘッダー行の設定 ws.Cells(1, 1).Value = "番号" ws.Cells(1, 2).Value = "名前" ws.Cells(1, 3).Value = "年齢" ws.Cells(1, 4).Value = "住所" ws.Cells(1, 5).Value = "電話番号" ws.Cells(1, 6).Value = "第1希望" ws.Cells(1, 7).Value = "第2希望" ws.Cells(1, 8).Value = "第3希望" ws.Cells(1, 9).Value = "当選日" ws.Cells(1, 10).Value = "人数" ' 残席数の初期化 remainingSeats = 8 ' 各行にデータを入力 For i = 1 To 50 ' 番号 ws.Cells(i + 1, 1).Value = i ' 名前 ws.Cells(i + 1, 2).Value = "参加者" & i ' 年齢（20歳から50歳の間でランダム） ws.Cells(i + 1, 3).Value = Int((50 - 20 + 1) * Rnd + 20) ' 住所 ws.Cells(i + 1, 4).Value = "住所" & i ' 電話番号（仮の番号を生成） ws.Cells(i + 1, 5).Value = "080" & Int((9999 - 1000 + 1) * Rnd + 1000) & Int((9999 - 1000 + 1) * Rnd + 1000) ' 第1希望 ws.Cells(i + 1, 6).Value = schedule(Int((UBound(schedule) + 1) * Rnd)) ' 第2希望 ws.Cells(i + 1, 7).Value = schedule(Int((UBound(schedule) + 1) * Rnd)) ' 第3希望 ws.Cells(i + 1, 8).Value = schedule(Int((UBound(schedule) + 1) * Rnd)) ' 当選日は空欄で初期化 ws.Cells(i + 1, 9).Value = "" ' 人数（1から残席数までのランダムな整数） ws.Cells(i + 1, 10).Value = Int(remainingSeats * Rnd) + 1 ' 残席数を更新 remainingSeats = remainingSeats - ws.Cells(i + 1, 10).Value If remainingSeats <= 0 Then remainingSeats = 8 End If Next i ' ファイル名の設定 fileName = ThisWorkbook.Path & "¥sample_data.csv" ' CSVファイルとして保存 ws.SaveAs fileName, xlCSV ' メッセージを表示 MsgBox "サンプルデータが生成されました:" & fileName, vbInformation End Sub （通りすがり） 2024/05/15(水) 09:33:14 ---- Sub AddScheduleFor180People() Dim ws As Worksheet Dim lastRow As Long, newRow As Long, i As Long Dim schedule As Variant Dim remainingSeats As Integer ' 希望日程のリスト schedule = Array("6/1?@", "6/1?A", "6/3?@", "6/3?A", "6/5?@", "6/5?A") ' ワークシートを指定 Set ws = ThisWorkbook.Sheets("Sheet1") ' シート名を適切なものに変更 ' 最終行を取得 lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row ' 残席数の計算 remainingSeats = 30 ' 新しいデータを追加する行を決定 newRow = lastRow + 1 ' 各行にデータを入力 For i = newRow To newRow + 179 ' 番号 ws.Cells(i, 1).Value = i - 1 ' 名前（適宜変更） ws.Cells(i, 2).Value = "参加者" & (i - 1) ' 年齢（適宜変更） ws.Cells(i, 3).Value = Int((50 - 20 + 1) * Rnd + 20) ' 住所（適宜変更） ws.Cells(i, 4).Value = "住所" & (i - 1) ' 電話番号（適宜変更） ws.Cells(i, 5).Value = "電話番号" & (i - 1) ' 第1希望 ws.Cells(i, 6).Value = schedule(Int((UBound(schedule) + 1) * Rnd)) ' 第2希望 ws.Cells(i, 7).Value = schedule(Int((UBound(schedule) + 1) * Rnd)) ' 第3希望 ws.Cells(i, 8).Value = schedule(Int((UBound(schedule) + 1) * Rnd)) ' 当選日は空欄で初期化 ws.Cells(i, 9).Value = "" Next i ' 残席数を更新 ws.Cells(182, 9).Value = remainingSeats End Sub （通りすがり） 2024/05/15(水) 09:38:50 ---- Excel365なので、関数でできるのかもしれませんが、私には環境がありませんので、 マクロ案を提示しておきます。 ・以下のレイアウトにしたうえで、 ・下記のマクロ を標準モジュールにコピーして ・マクロmainを実行してみて下さい。 【シートレイアウト】 ・A列からH列にはリクエストを入力してください。 ・Q1:V2に 実施日時 を入力してください。（日時はそちらで自由に設定して下さい） ・他のセルは、マクロで作成します。 【マクロ実行前】 A B C D E F G H I J K L M N O P Q R S T U V W 受付順No 名前 住所 希望人数 第1希望 第2希望 第3希望 実施日1 実施日2 実施日3 実施日4 実施日5 実施日6 1 5 6/1A 6/3A 6/5B 6/1A 6/1B 6/3A 6/3B 6/5A 6/5B 【マクロ実行後】 ・I列〜N列までが、受付番号ごと の決定内容です。 ・Q7〜 V36までが、実施日時ごと の決定内容です。 A B C D E F G H I J K L M N O P Q R S T U V W 受付順No 名前 住所 希望人数 第1希望 第2希望 第3希望 結果 実施日1 実施日2 実施日3 実施日4 実施日5 実施日6 1 5 6/1A 6/3A 6/5B 6/1A 5 6/1A 6/1B 6/3A 6/3B 6/5A 6/5B 2 2 6/1B 6/3B 6/5A 6/1B 2 限度 30 30 30 30 30 30 3 3 6/1A 6/3A 6/5B 6/1A 3 割当済み 30 30 30 30 30 30 4 2 6/5B 6/1B 6/5A 6/5B 2 余裕 0 0 0 0 0 0 0 5 4 6/1A 6/3A 6/5B 6/1A 4 6 1 6/5A 6/1A 6/3B 6/5A 1 当選者 当選者 当選者 当選者 当選者 当選者 7 4 6/1A 6/3A 6/5B 6/1A 4 1 2 11 34 6 4 8 2 6/1B 6/5B 6/3A 6/1B 2 1 2 12 34 9 4 9 4 6/5A 6/1A 6/3B 6/5A 4 1 8 12 34 9 19 10 2 6/5A 6/3B 6/5B 6/5A 2 1 8 16 34 9 19 11 1 6/3A 6/1B 6/5B 6/3A 1 1 13 16 34 9 19 12 2 6/3A 6/1A 6/3B 6/3A 2 3 13 16 36 10 19 13 以下、記載省略 【マクロ】(マジックナンバーだらけで失礼） Sub main() Dim k&, j& Dim nr&, num& Dim req$ Dim d& Dim allowance&, numOK& Dim pos& '初期設定 Range("I:N").ClearContents [P3] = "限度": [P4] = "割当済み": [P5] = "余裕" [Q3:V3] = 30 [Q4:V4] = 0 [Q5:V5].Formula = "=Q3-Q4" [W5].Formula = "=SUM(Q5:V5)" [Q7:V7] = "当選者" [Q8].Resize(30, 6).ClearContents '各受付番号の若い順（≒優先度高い順）に、決定していく For k = 2 To Cells(Rows.Count, "A").End(xlUp).Row nr = Cells(k, "A") num = Cells(k, "E") For j = 1 To 3 req = Cells(k, 5 + j) '希望日時 d = Application.Match(req, [Q2:V2]) + 16 '対応する列 allowance = Cells(5, d) 'その日時の余裕人数 If num <= allowance Then numOK = num Cells(4, d) = Cells(4, d) + numOK '割当済み数の更新 Cells(k, 9) = Cells(2, d) '希望日 ''希望順位別に分ける場合は、下記を使って下さい。 ''Cells(k, 10 + (j - 1) * 2) = numOK '割当済み人数 '当選者一覧への書き込み pos = Cells(Rows.Count, d).End(xlUp).Row + 1 Cells(pos, d).Resize(numOK, 1) = nr End If If num = 0 Then Exit For Next If Cells(5, "W") = 0 Then Exit For Next End Sub 一応、結果が出ることは確認しています。 なお、希望人数が例えば5人のとき、第一希望に3人、第二希望に2人という割り当てはせず、 同じ日時に5人の空きがなければ、割り当てない、としています。 （分割しても可という考えかたもあるかもしれません） （xyz） 2024/05/16(木) 19:35:41... - https://www.excel.studio-kazu.jp/wiki/kazuwiki/202405/20240514191811.txt - [detail] - similar
PREV
NEXT
Powered by Hyper Estraier 1.4.13, with 97050 documents and 608253 words.
訪問者：