Q&A
いくつもある項目を均等に振り分けたいと思っているんですが、ランダムなどの情報はいくつか目にしたのですが、順に振り分ける方法を探すことができませんでした。
1000近い項目があります。
その項目をひとつのグループが30行ずつに振り分けたいと考えています。
上の行からから２件ずつ（２行ずつA~Ｅ）を抽出。
例）1000÷30＝33.33…
33枚は最低30行グループが可能
２行ずつ振り分けるため、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 '今回作成フラグが１のものだけ印刷 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 コード
2023/03/18 01:16こちらの質問が複数のユーザーから「調査したこと・試したことが記載されていない質問」という指摘を受けました。
回答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
総合スコア435
あなたの回答
tips
プレビュー
下記のような回答は推奨されていません。
このような回答には修正を依頼しましょう。
また依頼した内容が修正された場合は、修正依頼を取り消すようにしましょう。