エクセルのシートに記入されたリストを分割する

# Summary

エクセルのシートに記入された一行一レコードのリストを分割する

## たとえば

これを

![Screen Shot 2019-08-04 at 18.43.52.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/149269/c189a283-6097-06e3-f38f-a43c93fd5224.png)


こんな感じで

![Screen Shot 2019-08-04 at 18.43.56.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/149269/d2a12bdc-ac03-7a64-a79c-c719e00f2b55.png)

![Screen Shot 2019-08-04 at 18.44.01.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/149269/f5ce8cf9-e9f7-f63d-b6f5-716716b75a20.png)

![Screen Shot 2019-08-04 at 18.44.08.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/149269/b8e3454f-46a1-edfe-9451-6d4ca40be3c5.png)



### VBAでのコード

たとえばこんな感じ

自作の関数と`ariawase`というライブラリを使ってますが、お好みで。

```vb

Option Explicit

''' ワークシートに記載されたレコードを３つのワークシートに転記する
''' リスト分割
Public Sub DivideList()

    Dim n As Long: n = 3

    ''' くだものシートからレコードを配列にする
    Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets("リスト")
    Dim header: header = ws.Rows(1): koffeeArray.ArrayBase0_2ndDimension header ''' 配列ベースはゼロにする
    Dim body: body = ArrSlice(GetVal(ws.Range("A2").CurrentRegion), 1)
    
    ''' くだもの n　シートを削除する
    Dim vv As Worksheet, rgx As Object: Set rgx = CreateRegExp("リスト\d.*")
    For Each vv In Worksheets
        If rgx.Test(vv.Name) Then
            koffeeExcel.DeleteSheet vv.Name
        End If
    Next

    ''' 分割した配列をそれぞれのシートに貼り付ける
    Dim v, tmpWs As Worksheet, i As Long: i = 1
    For Each v In ArrayWindow(body, n)

        ''' くだもの n シートを作成する
        Set tmpWs = koffeeExcel.AddSheet("リスト" & CStr(i))
        tmpWs.Cells.NumberFormat = "@"

        ''' レコードを記入する
        PutVal header, tmpWs.Range("A1")
        PutVal v, tmpWs.Range("A2")

        ''' 色づけ
        tmpWs.Range(tmpWs.Cells(1, 1), tmpWs.Cells(1, UBound(header(0)) + 1)).Interior.Color = RGB(200, 200, 200)
        ''' セルの幅調整
        tmpWs.Columns.AutoFit

        i = i + 1
    Next v

End Sub
```

### 分割する関数　ArrayWindow

サンプルはこんな感じ

```vb
''' 配列を３分割にする
Sub Sample_div3_array()

    ''' 配列を分割する数字
    Dim n As Long: n = 3

    ''' 配列を用意
    Dim arr(): arr = Array(1, 2, 3, 4, 5, 6, 7, 8)

    ''' 配列を３分割にする関数
    Dim v
    For Each v In ArrayWindow(arr, n)
        Debug.Print Dump(v)
    Next v

End Sub
```

結果

```vb
Array(1%, 2%, 3%)
Array(4%, 5%, 6%)
Array(7%, 8%)
```

元になる関数

```vb
Public Function ArrayWindow(ByVal arr As Variant, ByVal GroupN As Variant) As Variant

    ' Array(1..10) divided by 3
    ' -------------------------
    ' => Array(1%, 2%, 3%, 4%)
    ' => Array(5%, 6%, 7%)
    ' => Array(8%, 9%, 10%)
    
    ''' dependence: ariawase Core.ArrSlice
    

    ''' guard
    If Not IsArray(arr) Then Err.Raise 13
    If ArrRank(arr) > 1 Then Err.Raise 13
    If LBound(arr) < 0 Then Err.Raise 13
    
    ''' guard2( GroupN )
    Select Case GroupN
        Case Is <= 0: Err.Raise 13
        Case Is = 1:  ArrayWindow = Array(arr): GoTo Ending
        Case Is >= (UBound(arr) + 1)
            Dim tmpArray(): tmpArray = Array(): ReDim tmpArray(0 To UBound(arr))
            Dim idx As Long
            For idx = 0 To UBound(arr)
                tmpArray(idx) = Array(arr(idx))
            Next idx
            ArrayWindow = tmpArray
            GoTo Ending
        Case Else
            GoTo ArrayWindowImpl
    End Select
   
   
ArrayWindowImpl:

    Dim groupIndex As Long: groupIndex = Int(ArrLen(arr) / GroupN)
    Dim rest As Long: rest = ArrLen(arr) Mod GroupN
    
    ''' simple divison : e.g. 8 / 3 => array(2,2,2)
    Dim groupIndexArray(): groupIndexArray = Array(): ReDim groupIndexArray(0 To GroupN - 1)
    Dim i As Long
    For i = 0 To GroupN - 1
        groupIndexArray(i) = groupIndex
    Next i
    
    ''' add weight 1 : e.g. 8 / 3 => array(3,3,2)
    If Not rest = 0 Then
        Dim j As Long
        For j = 0 To rest - 1
            groupIndexArray(j) = groupIndexArray(j) + 1
        Next j
    End If
    
    ''' slice array by group index
    Dim ary(): ary = Array(): ReDim ary(0 To GroupN - 1)
    Dim k As Long, acc_idx As Long
    For k = 0 To UBound(groupIndexArray)
        ary(k) = Core.ArrSlice(arr, acc_idx, acc_idx + groupIndexArray(k) - 1)
        acc_idx = acc_idx + groupIndexArray(k)
    Next k
    
    ArrayWindow = ary
    
Ending:
End Function
```

現場からは以上です