質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

新規登録して質問してみよう
ただいま回答率
85.42%
Google スプレッドシート

Google スプレッドシートは、フリーで利用できる表計算ソフト。Webアプリのためインターネットに接続することで利用できます。チャートやグラフの作成のほか、シートを他のユーザーと共有したり、同時に作業を進めることも可能です。

Google Apps Script

Google Apps ScriptはGoogleの製品と第三者のサービスでタスクを自動化するためのJavaScriptのクラウドのスクリプト言語です。

Q&A

解決済

1回答

624閲覧

均等に振り分ける方法を教えていただけないでしょうか。

touch-touch

総合スコア4

Google スプレッドシート

Google スプレッドシートは、フリーで利用できる表計算ソフト。Webアプリのためインターネットに接続することで利用できます。チャートやグラフの作成のほか、シートを他のユーザーと共有したり、同時に作業を進めることも可能です。

Google Apps Script

Google Apps ScriptはGoogleの製品と第三者のサービスでタスクを自動化するためのJavaScriptのクラウドのスクリプト言語です。

0グッド

1クリップ

投稿2023/03/17 09:15

編集2023/03/17 11:07

いくつもある項目を均等に振り分けたいと思っているんですが、ランダムなどの情報はいくつか目にしたのですが、順に振り分ける方法を探すことができませんでした。

1000近い項目があります。
その項目をひとつのグループが30行ずつに振り分けたいと考えています。
上の行からから2件ずつ(2行ずつA~E)を抽出。
例)1000÷30=33.33… 
33枚は最低30行グループが可能
2行ずつ振り分けるため、1~66行がそれぞれの最初の段にくる
67~132行がその次にくる
つまり、一つ目のグループには「メインデータ」の
1.2.67.68.133.134.199.200.265.266.331.332.397.398.463.464.529.530.595.596.661.662.727.728.793.794.859.860.925.926の行が振り分けられる

30で全部が割り切れないと思いますので、グループが増えても、数個のグループが26~29行になるようにしてバランスをとれるのがベストです。

30年以上前に、友人がエクセルで作ってくれたものがあるのですが、私には扱えなくて、スプレッドシートで使用できるものを必要としています。

振り分け後の30行ずつのグループは、「メインデータ」のシートはそのままで、別のシートに作成できるようにしたいです。
また、振り分け前の「メインデータ」には、リンクが挿入されているため、振り分け後の30行ずつのデータにも、リンク情報がコピーされるようにしたいです。

友人が以前に作ってくれたエクセルのコードを、サンプルとして添付します。

どなたか、良い情報を教えていだだけないでしょうか。
よろしくお願いいたします。

Sub pro1() Dim 全行番号 Dim iデータカウント Dim 全データ(1 To 100000, 1 To 7) Dim Aデータ(1 To 10000, 1 To 7) Dim Bデータ(1 To 5000, 1 To 7) Dim Zデータ(1 To 100, 1 To 7) Dim head1(10), head2(11), 横1行分(10) Dim 行数, Z件数, B行数, A行数 As Integer Dim ページ行数 As Integer Dim A数 As Integer Dim 名 Dim 開始番号 As Integer Dim 番号 As Integer 'NEW 2007.02.07 Dim i全作成 As Integer Dim i開始行 As Integer Dim i開始部分作成 As Integer Dim i最大番号 As Integer Dim b部分作成でもヘッダー作成 '設定取得 Sheets("設定").Select チーム名 = Cells(4, 2) 'チーム名 開始番号 = Cells(5, 2) '開始する番号 A数 = Cells(8, 2) '1つのA数 ページ行数 = Cells(6, 2) '1つのA数 i全作成 = (Range("B7").Value) If i全作成 = 1 Then i開始行 = 1 i開始部分作成 = 開始番号 Else i開始行 = Range("B15") i開始部分作成 = Range("B16") i最大番号 = Range("B17") i_ret = MsgBox("部分作成が選択されています。既存のデータが上書きされる可能性がありますが、よろしいですか?", vbOKCancel + vbInformation, "チーム作成") If i_ret = vbCancel Then Exit Sub End If End If 'データの取り込み チームデータ = チーム 名 + "データ" Sheets(区域データ).Select 全行番号 = 0 iデータカウント = 0 While Cells(全行番号 + 1 + 3, 1) <> "END" Dim bGetThis As Boolean 'この行を取得するか 2007.02.07 '今回作成フラグが1のものだけ印刷 If i全作成 = 1 Then If Cells(全行番号 + 3, 9).Value = 1 Then bGetThis = True Else bGetThis = False End If ElseIf i全作成 = 2 Then If Cells(全行番号 + 3, 9).Value = 1 Then bGetThis = True Else bGetThis = False End If End If 全行番号 = 全行番号 + 1 If bGetThis Then iデータカウント = iデータカウント + 1 全データ(iデータカウント, 1) = Cells(全行番号 + 3, 1) 全データ(iデータカウント, 2) = Cells(全行番号 + 3, 2) 全データ(iデータカウント, 3) = Cells(全行番号 + 3, 3) 全データ(iデータカウント, 4) = Cells(全行番号 + 3, 4) 全データ(iデータカウント, 5) = Cells(全行番号 + 3, 5) 全データ(iデータカウント, 6) = Cells(全行番号 + 3, 6) 全データ(iデータカウント, 7) = Cells(全行番号 + 3, 7) End If Wend 'データの振分け(AチームとBチーム、Zに分ける) A数 = 0 B数 = 0 Z数 = 0 For Index = 1 To iデータカウント '対象外の抽出 If 全データ(Index, 7) <> "" Then 対象外行数 = 対象外行数 + 1 対象外データ(対象外行数, 2) = 全データ(Index, 2) 対象外データ(対象外行数, 3) = 全データ(Index, 3) 対象外データ(対象外行数, 4) = 全データ(Index, 4) 対象外データ(対象外行数, 5) = 全データ(Index, 5) 対象外データ(対象外行数, 6) = 全データ(Index, 6) 対象外データ(対象外行数, 7) = 全データ(Index, 7) Else 'Aの抽出 A数 = A数 + 1 Aデータ(A数, 2) = 全データ(Index, 2) Aデータ(A数, 3) = 全データ(Index, 3) Aデータ(A数, 4) = 全データ(Index, 4) Aデータ(A数, 5) = 全データ(Index, 5) Aデータ(A数, 6) = 全データ(Index, 6) End If End If Next Index 'Aの作成 Sheets("ヘッダー").Select head1(0) = Cells(1, 1) head1(1) = チーム名 head1(2) = Cells(1, 3) head1(3) = Cells(1, 4) head1(4) = Cells(1, 5) head1(5) = Cells(1, 6) head1(6) = Cells(1, 7) head1(7) = Cells(1, 8) head1(8) = Cells(1, 9) head1(9) = Cells(1, 10) チーム名班 = チーム名 + "班" Sheets(チーム名班).Select '全作成のときは、データを消去する If i全作成 = 1 Then Cells.Select Selection.ClearContents Else i_ret = MsgBox("部分作成が選択されています。以前のデータを消す場合は「はい」" & vbCrLf & "、消さない場合は「いいえ」を押してください", vbYesNo + vbInformation, "チーム作成") If i_ret = vbYes Then Cells.Select Selection.ClearContents b部分作成でもヘッダー作成 = True Else b部分作成でもヘッダー作成 = False End If End If '最初に始める場所を計算する 番号 = i開始行 行番号 = i開始行 + (i開始部分作成 - 開始番号) * ページ行数 ヘッダー行 = 2 + (i開始部分作成 - 開始番号) * 2 'ヘッダー分の行数 '全区域数の計算 '全作成のときは、件数を計算する If i全作成 = 1 Then If (A行数 / A数) = 0 Then チーム数 = A行数 / A数 Else If (A数 Mod A数) < (A数 / 2) Then チーム数 = CInt(A数 / A数) + 1 Else チーム数 = CInt(A数 / A数) End If End If Else '部分作成のときは、最大番号を取得する チーム数 = i最大番号 - 開始チーム番号 + 1 End If For Index = 1 To A数 横1行分(0) = 番号 横1行分(1) = Aデータ(Index, 2) 横1行分(2) = Aデータ(Index, 3) 横1行分(3) = Aデータ(Index, 4) 横1行分(4) = Aデータ(Index, 5) 横1行分(5) = Aデータ(Index, 6) Range(Cells(行番号 + ヘッダー行, 1), Cells(行番号 + ヘッダー行, 10)) = 横1行分 Range(Cells(行番号 + ヘッダー行, 1), Cells(行番号 + ヘッダー行, 10)).Font.Bold = False Range(Cells(行番号 + ヘッダー行, 1), Cells(行番号 + ヘッダー行, 10)).Font.Italic = False 番号 = 番号 + 1 行番号 = 行番号 + 1 Index = Index + 1 横1行分(0) = 番号 横1行分(1) = Aデータ(Index, 2) 横1行分(2) = Aデータ(Index, 3) 横1行分(3) = Aデータ(Index, 4) 横1行分(4) = Aデータ(Index, 5) 横1行分(5) = Aデータ(Index, 6) Range(Cells(行番号 + ヘッダー行, 1), Cells(行番号 + ヘッダー行, 10)) = 横1行分 Range(Cells(行番号 + ヘッダー行, 1), Cells(行番号 + ヘッダー行, 10)).Font.Bold = False Range(Cells(行番号 + ヘッダー行, 1), Cells(行番号 + ヘッダー行, 10)).Font.Italic = False 行番号 = 行番号 - 1 番号 = 番号 - 1 行番号 = 行番号 + ページ行数 ' 行番号 = 行番号 + A数 ヘッダー行 = ヘッダー行 + 2 ' If 行番号 > チーム数 * A数 Then If 行番号 > チーム数 * ページ行数 Then 番号 = 番号 + 2 行番号 = 番号 ヘッダー行 = 2 End If Next Index '全作成のときは、ヘッダーを作成する If i全作成 = 1 Or b部分作成でもヘッダー作成 Then 'Aのヘッダー 行番号 = 2 For Index = 開始番号 To 開始番号 + 数 - 1 head1(0) = Index Range(Cells(行番号, 1), Cells(行番号, 10)) = head1 Range(Cells(行番号, 1), Cells(行番号, 10)).Font.Bold = True Range(Cells(行番号, 1), Cells(行番号, 10)).Font.Italic = True ' 行番号 = 行番号 + A数 + 2 行番号 = 行番号 + ページ行数 + 2 Next Index End If '後処理 Sheets("設定").Select Range("B20").Value = A行数 Range("B21").Value = チーム数 Range("B22").Value = 開始番号 + 数 - 1 Call MsgBox("処理が無事に終了しました", vbOKOnly, "チーム") End Sub コード

気になる質問をクリップする

クリップした質問は、後からいつでもMYページで確認できます。

またクリップした質問に回答があった際、通知やメールを受け取ることができます。

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

guest

回答1

0

ベストアンサー

質問からずいぶん日数が経過していますが、当初の質問に削除要請がなされてしまって回答できずにいたのですが、
今ほど、この質問を見つけたので、当時作成していた回答を今更ながらアップしてみます。
シート1のデータに基づき、チームごとのシートを作成してデータを割り振ります。

JavaScript

1function divideTeams() { 2 const numMember = 30;//←チームの人数を指定 3 const sheetName = 'シート1';//元データのシート名を指定 4 const rowBegin = 2;//←データの開始行を指定 5 const columnUrl = 'F';//←URLの列を指定 6 const ss = SpreadsheetApp.getActiveSpreadsheet(); 7 const sheet = ss.getSheetByName(sheetName); 8 const values = sheet.getDataRange().getValues(); 9 const title = rowBegin > 1 ? values.splice(0, rowBegin - 1) : false; 10 //シートのデータを取得してチームに振分け 11 const numData = values.length; 12 const numTeam = Math.ceil(numData / numMember); 13 const teams = []; 14 let ix = 0; 15 for (let i = 0; i < numTeam; i++) { 16 const temp = values.filter((v, index) => index % (numTeam * 2) == 0 + ix || index % (numTeam * 2) == 1 + ix); 17 teams.push(temp); 18 ix = ix + 2; 19 } 20 //振り分けたチームごとにシート(無いなら作成)にデータを挿入 21 if (teams.length > 0) { 22 const sheets = ss.getSheets(); 23 for (i = 0; i < numTeam; i++) { 24 const name = 'チーム' + (i + 1); 25 //シートが無いなら作成 26 let isMach = false; 27 for (const iSheet of sheets) { 28 if (iSheet.getName() == name) { 29 isMach = true; 30 break; 31 } 32 } 33 if (!isMach) { 34 ss.insertSheet(name); 35 } 36 //シートに挿入 37 const newSheet = ss.getSheetByName(name); 38 newSheet.clear(); 39 if (title) { 40 newSheet.getRange(1, 1, title.length, title[0].length).setValues(title); 41 } 42 newSheet.getRange(newSheet.getLastRow() + 1, 1, teams[i].length, teams[i][0].length) 43 .setValues(teams[i]); 44 newSheet.getRange(columnUrl + ':' + columnUrl).setNumberFormat('General');//念のため 45 } 46 } 47}

投稿2023/05/12 10:03

編集2023/05/12 12:45
YellowGreen

総合スコア756

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

15分調べてもわからないことは
teratailで質問しよう!

ただいまの回答率
85.42%

質問をまとめることで
思考を整理して素早く解決

テンプレート機能で
簡単に質問をまとめる

質問する

関連した質問