ノンプログラマーの特権？

こんにちは。
派犬事務員のコロ子です。

新しい部署での仕事

4月から異動になってそろそろ2ヶ月。何をしているかというと「こーゆーの作って」の頼まれ仕事をしている。
事務仕事のルーチンワークは持たず、毎日VBA三昧。ノンプログラマーとしては最高の環境！？なのかな。

上司から分厚いファイルを渡されて「特にイメージはないんだけど、これをいい感じに作って」と言われて悩む。
う～ん、やっぱりAccess案件かなぁ。Access苦手なんだよなぁ。
最初の何日かはただ資料を眺めるだけで何も進まない。考えがまとまらず、ちょっと作ってはボツ、ちょっと作ってはボツを繰り返す。
本当に成果ゼロ。焦る。
今までは事務仕事を持っていたから、マクロ作成の時間の捻出に苦労したけど、進まなくてもその日の仕事の成果ゼロはなかった。
そしてほんのちょっと中途半端にデータベースについて勉強したせいで、リレーションとか正規化とかを意識して、どこから手を付けていいのか分からなくなった。
焦るばかりで何も進まない。
期日の半分くらいが過ぎて焦りが限界に達し「もう、これ以上は無理！正しいとか間違っているとかどーでもいい！」半ばやけになって作り始めた。
テーブル3個くらい作った時点で上司に「Accessで作ってます」と無意味な中間報告をして無理やり進める。なんとか期日に間に合い、とりあえずOKを貰った。
そして後から「あーしたい、こーしたい」がいろいろ出てきて無理やり後付けで推し進めて、スパゲッティのように複雑にからまりまくった謎のデータ構造に仕上がった。
こんなんで、後々メンテナンスできるのだろうか。
お給料の値上げ交渉どころか、お金貰えるレベルに至っていないことがいたたまれない。
どうすれば良かったのだろう。正解が分からない。

過去を振り返る

そして気になる事がある。
今までもAccessを使っていたけど、リレーションとか正規化とか、そんな事は全く知らず、全然デタラメに作っていた。
前の部署で15年以上前に作ったAccessは今でも普通に使えている。
さらに言えば、みんな毎日使っていて、そのAccessがなければ仕事にならないくらいのメインデータベースだ。
そのデータベースを正しく作り直すとしたらどうだろうか？
リレーションとか正規化とかきちんとしたら、なんか使いにくくなりそうな気がする。
どうやっていいのかさっぱり分からない。
もしかしたらデーターベース的に正しくないから使える物になっているのではないか？
どの辺が正しくないかというと、正規化ななんて知らなかったからもちろん非正規化。
リレーションシップには
一対多
多対多
一対一
があるみたいだけど、どれにも当てはまらない。
強いて言うなら一対一の変則系？
お店とかではないので、よく本に載っている例題が参考にならない。
リレーションシップというより、その部署で働いている人なら誰でも知っている共通認識で繋がっている。でもその部署だけのものなので十分使えている。

もしプロが作るならそうはいかない。
みんなの共通認識をシステムに落とし込まなければならない。
プロなら100％正しく作る事が求められる。
コロ子のAccessは正しくないおかげで
・メインデータないのにサブデータが入力できたり
・本来ユニークなはずのデータが重複できたり
・マスターテーブルにないものが入力できたり
あり得ないことが、意外と融通が利いて便利だったりする。
プロには絶対作れない。

Excelだって表計算ソフトだけど、絵を描く人もいる。
やりたい事が出来れば、使い方が正しいとか間違っているとかは関係ない。
使い方は自由だ。

もしかしたら、
自由な使い方ができるのはノンプログラマーの特権
なのかもしれない。

Excelで組織図を作成（２）兼任の場合と集計

こんにちは。
派犬事務員のコロ子です。

前回書いた「Excelで組織図を作成する」の続き。
組織図を作成した後に、
「○○さんは今年度からA課とB課を兼任することになった」とか
「組織図の下の方に集計の表を載せたい」とか
必ず何か出てくる。
先に言ってくれればいいのに、と思うけど、完成図を見てから思い出すんだろうな、きっと。

兼任の場合は？

例えば、コロ子が第一部のA課とB課を掛け持ちすることになった場合
名簿テーブルのデータを追加する

一覧表に同じ人がダブっているのが気持ち悪く感じるかもしれないけど、こうすればコードはそのままで複数部署に所属できる。

集計

兼任の列を追加して配分を入力。

1÷重複数を計算するマクロを作成したけど
配分が「A部署：B部署＝3：7」とか、3部署掛け持ちで割り切れない、などで結局は手入力。

別シートに集計表を作る

ここでもマクロを作りたくなるけど、関数の方が簡単なのでSUMIFS関数を使う。
第一部、A課、A区分の合計は
=SUMIFS(名簿!$H:$H, 名簿!$F:$F, "第一部", 名簿!$G:$G, "A課", 名簿!$D:$D, "A")

集計表を張り付け

この集計表を図として貼り付けする

表をコピーする

組織図の図を貼りたい位置で右クリックして
「その他の貼り付けオプション」→「リンクされた図」を選択して張り付ける

集計表も図なので好きな位置に移動できる。

図のプロパティを
「セルに合わせて移動やサイズを変更しない」にする。

こんなふうに列が増えたり減ったりしても形が崩れない。

Tips

【図形をまとめて選択する。】

「ホームタブ」→「検索と選択」→「オブジェクトの選択」

マウスでドラッグした範囲の図形が選択される。

まとめて移動する時に便利！

【図形の位置を揃える】

位置を揃えたい図形を選択して
「書式タブ」→「配置」より図形の位置を揃えられる

Excelで組織図を作成

こんにちは。
派犬事務員のコロ子です。

4月は部署異動の時期ですね。（もう5月になっちゃったけど）
コロ子もこの4月からから新しい部署に異動になった。
今年は異動も多く、新しい部署ができたりかなり大胆な組織変更があった。
そこで上司から「組織図を簡単に作れるようなツールを作って」の依頼がきた。
現行はエクセル方眼紙で作成していて、変更がある度に、コピーしたりセルを結合したり、修正に手間がかかっている。

マクロを作るにあたって、セルに書き込むタイプだと形を整えるのが大変なので、セルの代わりに図形にして、好きな位置に置く事にした。
【完成図】

項目は図形なので、イレギュラーな場合でも自由に移動できる。
例えば、後から「こんな風にしたい」とか言われても対応OK。

下準備

別のシートに社員の一覧表を作成する。

こんな感じで必要な項目を一覧表にしてテーブルにする。
表にカーソルを置いて「Ctr＋T」でテーブルに変更できる。
テーブル名は「名簿テーブル」とした。
テーブルは最近のお気に入り。

コード

まずは図形の上位置と高さを決める。これと思う数字を入れて後で調整する。
名簿テーブルの列番号もEnuｍにする。

'図形の位置上側*******************
Const POSITION1 As Long = 70 '事業部長
Const POSITION2 As Long = 180 '部長
Const POSITION3 As Long = 300 '課長
Const POSITION4 As Long = 360 '課員

'図形の高さ***********************
Const HEIGHT1 As Long = 60 '管理職用
Const HEIGHT2 As Long = 20 '一般職用


'名簿テーブルの列
Enum colname

    c_Id = 1
    c_Name
    c_Gender
    c_Employ
    c_Position
    c_bu
    c_Ka
    c_Count

End Enum

名簿テーブルより図形を作成する。
ちょっとややこしいけどポイントは
Dictionaryオブジェクトで部＋課をキーにして部署ごとに要素を作成する。
アイテムを配列（Collectionオブジェクト）にして部署のメンバーの情報（名簿テーブルの行）を入れる。

【クラスモジュール：PersonData】

Private person As Collection

Sub init(lst As ListRow)

    Set person = New Collection
    person.Add lst

End Sub

Sub Add_dic(lst As ListRow)

    person.Add lst
    
End Sub

Public Property Get GetPersonData() As Collection

   Set GetPersonData = person

End Property

【標準モジュール】
名簿テーブル：Sheet1
組織図：Sheet3
に作成。

'Dictionaryオブジェクトの参照設定(Microsoft Scripting Runtime)忘れずに！

Sub Organizational_Chart()

Application.ScreenUpdating = True


Dim teamDic As Dictionary
Set teamDic = New Dictionary

Dim lst As ListObject
Set lst = Sheet1.ListObjects("名簿テーブル")

Dim ran As ListRow
Dim Kanrisyoku() As ListRow　 '事業部長と部長
Dim i As Long

For Each ran In lst.ListRows

    If ran.Range(c_Ka) <> "" Then
    
        '部と課の組み合わせをキーとする
        Dim dickey As String
        dickey = ran.Range(c_bu) & ran.Range(c_Ka)
        
        
        If teamDic.Exists(dickey) Then
        
            Call teamDic.Item(dickey).Add_dic(ran)
                   
        Else
        
            teamDic.Add dickey, New PersonData
            Call teamDic.Item(dickey).init(ran)
        
        End If
        
    Else
    
        ReDim Preserve Kanrisyoku(i)
        Set Kanrisyoku(i) = ran
        i = i + 1

    End If

Next ran



'人ごとに図形を作成する
Dim place As Long

Dim buf As Variant
For Each buf In teamDic.Keys

    Call MakeShape(teamDic.Item(buf).GetPersonData, place)
    place = place + 1

Next buf


'事業部長、部長を作成
Call SapeKanrisyoku(teamDic, Kanrisyoku)

Application.ScreenUpdating = True

End Sub

図形の位置とテキストを作成する

Sub MakeShape(coll As Collection, place As Long)

Dim left As Long
Dim top As Long

Dim c As Long
c = POSITION4  '一般職員用トップの位置

Dim i As Long
For i = 1 To coll.Count

    With coll(i)
    
        '左位置の調整
        left = 50 + (100 + 50) * place
        
        Dim height As Long
        height = HEIGHT2
        
        '上位置の調整
        top = GetTop(c, .Range(c_Position), height)
        
        
         '表示名
        Dim nameText As String
        nameText = MakeTaxtName(.Range(c_Name), .Range(c_Ka), .Range(c_Position), .Range(c_Employ))
    
    End With
    
    Call ShapeAdd(nameText, coll(i).Range(c_Employ), left, top, height)

Next i

End Sub

'表示名を作成
Function MakeTaxtName(name As String, Section As String, Position As String, emp As String) As String

    If Position <> "" Then
            
        MakeTaxtName = Section & vbCrLf & name & vbCrLf & Position & "  (" & emp & ")"
        
    Else

        MakeTaxtName = name & "  (" & emp & ")"
    
    End If

End Function

'図形の上位置をセットする
Function GetTop(ByRef c As Long, Position As String, ByRef height As Long) As Long

If Position = "課長" Then

    GetTop = POSITION3
    height = HEIGHT1

Else '一般職員

    GetTop = c
    c = c + 20
    height = 20

End If

End Function

図形を作成（プロパティをセットする）

Sub ShapeAdd(nameText As String, Employ As String, left As Long, top As Long, height As Long)

Dim R As Long
Dim G As Long
Dim B As Long

  With Sheet3.Shapes.AddShape _
   (msoShapeRectangle, left, top, 100, height) '図形のタイプ、左位置、上の位置、幅、高さ

    '表示文字の指定
    .TextFrame.Characters.Text = nameText
    .TextFrame.Characters.Font.Size = 10.5
    
    '図形内テキストのフォントカラーを指定する
    .TextFrame.Characters.Font.Color = RGB(0, 0, 0)
    
    '図形内のテキスト水平方向を中央位置にする
    .TextFrame.HorizontalAlignment = xlHAlignCenter
    
    '図形内のテキスト縦方向を中央位置にする
    .TextFrame.VerticalAlignment = xlVAlignCenter

    Call MakeRGB(Employ, R, G, B)

    '図形の枠線の色を指定する
    .Line.ForeColor.RGB = RGB(0, 0, 0)
    .Line.Weight = 1

    '図形の塗りつぶし色を指定する
    .Fill.ForeColor.RGB = RGB(R, G, B)
    
    'セルに合わせて移動するがサイズ変更はしない
    .Placement = xlMove

  End With

End Sub

'雇用区分ごとに図形の色をセットする
Sub MakeRGB(ByVal Employ As String, R As Long, ByRef G As Long, ByRef B As Long)

Select Case Employ

    Case "A"
    
        R = 204
        G = 255
        B = 255
    
    Case "B"
    
        R = 255
        G = 255
        B = 153
    
    Case "C"
    
        R = 153
        G = 204
        B = 255
     
    
    Case "犬"
    
        R = 146
        G = 208
        B = 80
    
  
End Select

End Sub

管理職（事業部長、部長）用の図形を作成する
位置合わせは力ずく。（上手くできなければ後で移動してもOK)

Sub SapeKanrisyoku(teamDic As Dictionary, Kanrisyoku() As ListRow)


Dim left1 As Long
Dim left2 As Long
Dim top As Long
Dim height As Long
Dim nameText As String

Dim ran As Variant

For Each ran In Kanrisyoku()

    nameText = MakeTaxtName(ran.Range(c_Name), ran.Range(c_bu), ran.Range(c_Position), ran.Range(c_Employ))
    height = HEIGHT1
    

    If ran.Range(c_Position) = "事業部長" Then
    
        top = POSITION1
        left1 = (50 + (100 + 50) * teamDic.Count + 100) / 2 - 50 - 50
        Call ShapeAdd(nameText, ran.Range(c_Employ), left1, top, height)
        

    ElseIf ran.Range(c_Position) = "部長" Then
    
        top = POSITION2
        
        Dim buf As Variant
        Dim cnt As Long
        For Each buf In teamDic.Keys
        
            If InStr(buf, ran.Range(c_bu)) <> 0 Then
            
                cnt = cnt + 1
            
            End If
        
        Next buf
        
        left2 = left2 + 50 + ((100 + 50) * cnt - 50) / 2 - 50

        Call ShapeAdd(nameText, ran.Range(c_Employ), left2, top, height)
        
        left2 = (100 + 50) * cnt
        cnt = 0
        
    End If
        
Next ran


End Sub

【図形の初期化】
図形を作成した後に引いた線はそのままにしたいので、Rectangle（図形）とPicture（後で作成する集計の表）のみを削除

Sub DelShape()

Application.ScreenUpdating = False

Dim shp As Shape

For Each shp In Sheet3.Shapes

    If InStr(shp.name, "Rectangle") <> 0 Or InStr(shp.name, "Picture") <> 0 Then
    
        shp.Delete
    
    End If
 
Next shp

Application.ScreenUpdating = True

End Sub

図形の作成は出来たので、ボタンを作成して下記コードを登録すれば完成！

Sub Main()
    
    Call DelShape
    
    Call Organizational_Chart
    
End Sub

線はマクロで作るの大変なので手作業でお願いします！

追加

クラスモジュールの挿入の仕方

「クラスモジュール：PersonData」はクラスモジュールのコードを書いてください。
新規のクラスモジュールを追加します。
挿入→クラスモジュール

クラスモジュールのオブジェクト名を変更します。
「Class1」→「PersonData」
オブジェクト名はプロパティウインドウから変更できます。

コロ子勘違いしていた インスタンスの生成

こんにちは。
派犬事務員のコロ子です。

クラスのインスタンスの生成でちょっと気になる事がある。
ループをしながらDictionaryオブジェクト（Collection オブジェクトでも）のアイテムにクラス型のオブジェクトを追加する場合、ループの中でインスタンスを生成しているコードをよく見かける。

【例】
クラスモジュール：Class1

Public data As Long

'標準モジュール

Sub Test1()

Dim dic As Dictionary
Set dic = New Dictionary

Dim i As Long

For i = 1 To 3

    Dim dicitem As Class1
    Set dicitem = New Class1
    
    Dim dickey As String
    dickey = "キー" & i
    
    dicitem.data = i * 2
    
    dic.Add dickey, dicitem

Next i


Dim j As Variant
For Each j In dic.Keys

    Debug.Print dic.Item(j).data

Next j

End Sub

イミディエイトウインドウ

2
4
6

結果は正しいけど、なんか納得できない。
なんでループの中でインスタンスを生成しているのだろう？

次のコードTest2、Test3を見ると

Sub Test2()

Dim dic As Dictionary
Set dic = New Dictionary

Dim dicitem As Long

Dim i As Long

For i = 1 To 3

    Dim dickey As String
    dickey = "キー" & i

    dicitem = i * 2
    
    dic.Add dickey, dicitem

Next i


Dim j As Variant
For Each j In dic.Keys

    Debug.Print dic.Item(j)

Next j

End Sub

イミディエイトウインドウ

2
4
6

test2で、DictionaryオブジェクトのアイテムにLong型の変数を入れると値渡ししているように思える。

Sub Test3()

Dim dic As Dictionary
Set dic = New Dictionary

'先にインスタンスを生成する
Dim dicitem As Class1
Set dicitem = New Class1

Dim i As Long

For i = 1 To 3

    Dim dickey As String
    dickey = "キー" & i
    
    dicitem.data = i * 2
     
    dic.Add dickey, dicitem

Next i


Dim j As Variant
For Each j In dic.Keys

    Debug.Print dic.Item(j).data

Next j

End Sub

イミディエイトウインドウ

6
6
6

でもtest3では参照渡ししているように思える。
ということはtest1では同じ変数名で何度もインスタンスを生成しているということなの？？
混乱。

仕方ないのでノンプロ研で質問してみたところ、コロ子、インスタンスの生成について分かっていなかったことが判明。

【分かった事】
①オブジェクト型の変数には参照先が格納される。
なのでTest3ではDictionaryオブジェクトのキー1～3のアイテムには同じインスタンスが格納されている。

②New クラス名でいくつでもインスタンスを生成できる。
Dim 変数名 As クラス名
Set 変数名 = New クラス名
はセットで1変数1インスタンスだと思っていた。
「New クラス名でインスタンスを生成できる」は耳にタコができるほど聞いていたのに・・・。
Dim 変数名 As クラス名　でクラス型の変数を宣言
Set 変数名 = New クラス名　で生成したインスタンスを変数に格納するという意味だった！

Dim A As Class1
Set A = New Class1
Set A = New Class1

と書いたら、2行目のAと3行目のAには別のインスタンスが格納されている。

変数宣言はループ中に書いたら1度しか処理されないのと同じで、
Set 変数名 = New クラス名も1度しか処理されないのかと思っていた！

ちなみに次のように書くとクラス型変数の宣言が不要。

'--省略--
Dim dicKey As String
For i = 1 To 3
    dicKey = "キー" & i
    dic.Add dicKey, New Class1
    dic.Item(dicKey).data = i * 2
Next i
'--省略--

そーゆーことなのね！！

ということは、前回の記事で書いたコードはクラス型のオブジェクトを配列にしたりして、普通に分かっている人からしたら意味不明なんだろうな・・・。

クラスモジュール、シートモジュールは前回のまま
標準モジュールのみ書き直し。

Public Sub Aggregate()

Dim list As ListObject
Set list = Sheet1.ListObjects(1)

Dim ran As ListRow

Dim dic As Dictionary
Set dic = New Dictionary

Dim i As Long

'データ読み込み
For Each ran In list.ListRows

    Dim dickye As String
    dickye = Sheet1.Key(ran)
    
    If dic.Exists(dickye) Then
        'すでにkeyが存在している時は、
        Call dic.Item(dickye).Add(ran)
        
    Else
    
        'keyが存在しない(初めて)時は、
        'Dicにクラス(RawData)型のオブジェクトを格納
        
        dic.Add dickye, New RawData
        Call dic.Item(dickye).Init(ran)
        
        i = i + 1
        
    End If

Next ran

Call Sheet2.Del


'データ書き出し
i = 2
Dim j As Variant
For Each j In dic.Keys

    Sheet2.Cells(i, cnNo).Value = dic.Item(j).No
    Sheet2.Cells(i, cnLot).Value = dic.Item(j).Lot
    Sheet2.Cells(i, cnData1).Value = dic.Item(j).data1
    Sheet2.Cells(i, cnData2).Value = dic.Item(j).data2
    Sheet2.Cells(i, cnData3).Value = dic.Item(j).Data3
    
    i = i + 1
    
Next j

Call Sheet2.MakeStyle
Sheet2.Activate

End Sub

インスタンスの生成、完全に理解した！（←こーゆーのが一番怪しい）

久々のVBA ノンプロ研中級講座の内容を活かす?

こんにちは。
派犬事務員のコロ子です。

実は去年12月にノンプロ研中級講座が終わってから、全くVBAを書いていなかった。
4月から部署を異動するので、ルーチン業務から外れ毎日雑用の日々。
最近はPython（GASにも）に気を取られてVBAはもうしばらくいいかなー、気分になっていた。

そんなダラダラした気分のところに上司から「マクロ作って」の依頼がきた。
VBAもういいや、な気分だったのに、話を聞いたらノンプロ研中級講座の内容がめちゃめちゃ使えそうだったから、少し気分が乗ってきた。

しかし、3ヶ月VBAをやってなかっただけなのに、関数の外にコード書いたり、変数を宣言するのを忘れたり、もうVBA忘れちゃったのかものひどい有り様だった。

ゆっくり良く考えてかっこいいコードが書きたかったけど、「急ぎ」だったので、とりあえず急いで作った。もっといい方法がないか今日考えたけど、時間があるからといっていいアイデア浮かぶわけでもない・・・。
でもノンプロ研中級講座の内容を盛り込めたと思う。

【内容】
下記のようなデータを番号、Lotが同じもので集計する。
データ1、データ2、データ3は各々最大値と最小値を除いて平均する。

表をテーブルにする。

表の中にカーソルを置いて「Ctrl＋T」を押すとテーブルになる！

色が付いてオシャレになっただけじゃない。
テーブルにすると表をオブジェクトとして扱えるから便利。

考え方

①表の「番号」と「Lot」を繋げた文字列をキーにする。
【例】
2行目の場合は「BBBabc」がキー

②表の1行分のデータを格納するクラスを用意する。

③表を1行づつ読み込んで、Dictionaryオブジェクトに格納する
Key：①で作成したキー
Item：②のクラスを配列にして、配列のインデックス番号

Dictionaryオブジェクトに格納する際、Keyがすでに存在していたら、そのインデックス番号のクラスのデータを集計する。

コード

クラスモジュール　RawDataクラス

Private no_ As String
Private lot_ As String
Private data1_ As Long
Private data2_ As Long
Private data3_ As Long
Private max1_ As Long
Private min1_ As Long
Private max2_ As Long
Private min2_ As Long
Private max3_ As Long
Private min3_ As Long
Private cnt_ As Long

'*初回の値をセット
Public Sub Init(ByVal list As ListRow)

    no_ = list.Range(cnNo)
    lot_ = list.Range(cnLot)
    
    data1_ = list.Range(cnData1)
    max1_ = data1_
    min1_ = data1_
    
    data2_ = list.Range(cnData2)
    max2_ = data2_
    min2_ = data2_
    
    data3_ = list.Range(cnData3)
    max3_ = data3_
    min3_ = data3_
    
    cnt_ = 1

End Sub


'*加算
Public Sub Add(ByVal list As ListRow)

    data1_ = data1_ + list.Range(cnData1)
    Call MaxMin(max1_, min1_, list.Range(cnData1))
    
    data2_ = data2_ + list.Range(cnData2)
    Call MaxMin(max2_, min2_, list.Range(cnData2))
    
    data3_ = data3_ + list.Range(cnData3)
    Call MaxMin(max3_, min3_, list.Range(cnData3))
    
    cnt_ = cnt_ + 1

End Sub

'最大値と最小値を探す
'(max, minはByRefにして変数の中身を置き換える）
Public Sub MaxMin(ByRef max As Long, ByRef min As Long, ByVal Data As Long)

    If Data > max Then
        max = Data
    ElseIf Data < min Then
        min = Data
    End If

End Sub


'番号
Public Property Get No() As String

    No = no_

End Property

'ロット
Public Property Get Lot() As String

    Lot = lot_

End Property

'データ1
Public Property Get Data1() As Long

    Data1 = WorksheetFunction.Round((data1_ - max1_ - min1_) / (cnt_ - 2), 0)

End Property

'データ2
Public Property Get Data2() As Long

    Data2 = WorksheetFunction.Round((data2_ - max2_ - min2_) / (cnt_ - 2), 0)

End Property

'データ3
Public Property Get Data3() As Long

    Data3 = WorksheetFunction.Round((data3_ - max3_ - min3_) / (cnt_ - 2), 0)

End Property

Sheet1モジュール

Public Property Get Key(list As ListRow) As String
    
    Key = list.Range(cnNo) & list.Range(cnLot)

End Property

Sheet2モジュール

Public Sub Del()

    Me.UsedRange.Offset(1, 0).Delete

End Sub

Public Sub MakeStyle()

'罫線
Me.Range("A2").CurrentRegion.Borders.LineStyle = xlContinuous
'ソート
Me.Range("A2").CurrentRegion.Sort Key1:=Range("A1"), _
                                  Order1:=xlAscending, _
                                  Key2:=Range("B1"), _
                                  Order2:=xlAscending, _
                                  Header:=xlYes


End Sub

標準モジュール

参照設定：Microsoft Scripting Runtimeを忘れずに。

Public Enum ColumnName

    cnNo = 1
    cnLot
    cnData1
    cnData2
    cnData3

End Enum

Public Sub Aggregate()

Dim list As ListObject
Set list = Sheet1.ListObjects(1)

Dim ran As ListRow

Dim Dic As Dictionary
Set Dic = New Dictionary

'RawDataクラスは動的配列にする
Dim Data() As RawData
Dim i As Long

'データ読み込み
For Each ran In list.ListRows

        Dim kye As String
        kye = Sheet1.Key(ran)
        
        If Dic.Exists(kye) Then
            'すでにkeyが存在している時は、配列のインデックス番号のデータを加算
            Call Data(Dic.Item(kye)).Add(ran)
            
        Else
        
            'keyが存在しない（初めて）時は、Dicにデータを格納
            ReDim Preserve Data(i)
            Set Data(i) = New RawData
            
            Dic.Add kye, i
            Call Data(i).Init(ran)
            i = i + 1
        End If

Next ran

Call Sheet2.Del

'データ書き出し
For i = 2 To UBound(Data) + 2

    Sheet2.Cells(i, cnNo).Value = Data(i - 2).No
    Sheet2.Cells(i, cnLot).Value = Data(i - 2).Lot
    Sheet2.Cells(i, cnData1).Value = Data(i - 2).Data1
    Sheet2.Cells(i, cnData2).Value = Data(i - 2).Data2
    Sheet2.Cells(i, cnData3).Value = Data(i - 2).Data3

Next i

Call Sheet2.MakeStyle
Sheet2.Activate

End Sub

集計結果

こんな感じで集計。

①シートモジュールを使う
②配列
③クラス
④テーブル
などなど、中級講座の内容。
今だから正直に言うけど、テーブルについては知らなかったし、クラスもちょっと自信なかった。TAじゃなくて受講するレベルだった疑惑があるけど、テーブルもクラスも使って作ったから許して～。

職場でプログラミング部を作成

こんにちは。
派犬事務員のコロ子です。

最近Googleの凄さがなんとなく分かってきた。（今更）
無料のGoogleアカウントを作成すれば、Excelみたいのとか、Wordみたいのとかその他いろいろタダで使えるし、ネット上のエリアに15GBまで無料で保存できる。
しかも、他のPCとかスマホとかからもアクセスできて、他の人とも共有できたり、凄く便利じゃない！？（今更）
パッケージ版Microsoft office派の会社で働いていると、なかなかこの感覚が分からない。

また、ノンプロ研でチャットツールのSlackを使っていて、これもすごく便利。会社で使っているところもけっこうある。コロ子が会社の人に、こういうツールあるんだよ、と口頭で説明しても、みんな？？？ってなるし、「うちの会社、そういうのダメだから」と一蹴されてしまう。

そうはいっても世の中便利なもの沢山ある。知らないのはもったいない。
会社はクラウド不可、アプリのダウンロード不可だけど、プライベートで遊びでやる分には構わないよね？
部活みたいな感じにして、いろいろ便利なITツールを使ったり、プログラミングをしたりしてみんなで一緒に勉強していくのはどうだろうか？

これから会社も変わっていかなければならないだろうから、若い人たちが（若くなくても）こういうのに慣れて、便利だから導入しましょう、みたいな働きかけができればいいし、「自分で仕事に最適な便利ツールを探して、使いこなす力」というもの必要なのではないかと思う。
アプリなどのダウンロードも、ちゃんと申請して情シスの許可が降りればできるらしい。どのような物をどのように使って、どのような効果があるかをちゃんと説明できる力も必要。

そんな訳でプログラミング部を作ってみた。

IT部にしようか迷ったけど
コロ子＝VBA
みたいなイメージはできていると思うので、プログラミング部の方が馴染むかな。
それにIT語れるほど詳しくないし・・・。
業務関係なく「ゆる～くプログラミングして遊ぼう」を全面に押し出し、やってみよう。

部員を募集

部員募集の張り紙をしてみたところ、8人集まった。
すごい！優秀な人ばっかり！！
Slackでのオンライン部活。
嬉しいことにSlack経験者ゼロ。それだけでも部活作った甲斐ある。
仕事は関係ないので、自宅のパソコンで、オンラインでの部活動。
自宅のパソコンだとExcel（Office）が入ってない人もいるから、VBAよりGASやPythonがメインかな。

部活を作って早速だけど、コロ子休みを取ってちょっと出かけてくる。
コロ子が帰ってくるまでに課題を出しておいたけど、みんなやってくれるかな。
（今回はパソコンを持って行かないので、ちょっと心配）
提出期限は来週だけど、まだ誰も出してくれてない。
でも、誰もやってくれなくても大丈夫。
ノンプロ研で学んだスーパードライがある。
（スーパードライ：周りとの温度差があっても気にしないでクールに乗り切る術。ダメだったらやり方を変えればいいだけ。）

koroko-resort.hatenablog.com

Pythonでゲームを写経

こんにちは。
派犬事務員のコロ子です。

Pythonでゲーム

そろそろ何かそれっぽい物を作ってみたい。
基礎編、難しいところはすっ飛ばしてゲームコードを写経してみた。

洞窟の中をロケットが進むゲーム。
洞窟は色の付いた画面に、黒い長方形をループしながら位置と形を変えて追加していく。新しい長方形を追加したら最初の長方形を消す。
そうすることによって画面が動いているように見える。
全然分かんないけど、早くゲームで遊びたいから、取り急ぎ写経。

よし！できた！

ゲームスタート！

え！！！マジ！絶対ムリ！！

コードをよーく見てみると、間違ってる。
偶然できたバグが無理ゲー過ぎてビックリ！

実際にはこんな感じでどんどん洞窟が狭くなる。まっすぐ飛ぶのが結構難しい。

写経成功

今回覚えた事

Pythonの配列？（リストとかタプルとか）はインデックス番号を-1とすると、最後の要素が取れる。

test = [1,2,3,4,5]
print(test[1])
print(test[-1])

　↓

2
5

便利！
なんかいっぱいコード書いたけど、はっきり理解できたのはこれくらい。
バグの原因はループのインデントが間違っていた。
ループを抜けるにはインデントを戻さないといけないけど、本だとインデントの位置が分かりにくくて、まだちょっと慣れない。