集計関係サンプルマクロ

項目ごとに集計する 項目が複数ある場合のクロス集計

項目が1つ、値が1つだけの単純なものならDictionaryオブジェクトで十分ですが、
大分類の中に中分類があって、さらに小分類があって・・・・・・といったように
項目が複数の場合、クロス集計するにはADODBを使うと便利です。

ADODBとは?


ADODBとは、データベースにアクセスする方法で、これを使うと
ExcelでもAccessみたいにデータベースとして集計できます。

多少データベースの知識が必要ですが、Dictionaryオブジェクトだと
難しい高度な集計をしたいときに重宝します。

ピボットテーブルのデータ元にレコードセットを指定できるため、
特にExcelでクロス集計したいときに便利です。

レコードセットを元にピボットテーブルを作成する


まず、ADODBを使うには「Microsoft ActiveX Data Objects 2.x Library」参照設定が必要です。
xはバージョンが入ります。理由がなければ最新のバージョンにしておきます。

レコードセットを元にピボットテーブルを使う場合は、以下の流れになります。

  1. レコードセットにデータを取得

  2. PivotCachesコレクションに、PivotCacheオブジェクトを作成

  3. PivotCacheオブジェクトのRecordsetプロパティにレコードセットを指定

  4. CreatePivotTableメソッドでピボットテーブルを作成

  5. ピボットテーブルの行フィールド・列フィールド・合計フィールドを指定



サンプルコード



Sub レコードセットからピボットテーブルを作成する()

Dim objRS As New ADODB.Recordset
Dim objPivotCache As PivotCache
Dim strPivotName As String
Dim i As Long

With objRS
  '◆フィールド定義
  .Fields.Append "ID", adInteger
  .Fields.Append "カテゴリ", adVarChar, 1
  .Fields.Append "項目", adVarChar, 255
  .Fields.Append "日付", adDate
  .Fields.Append "値", adDouble
  .Open
  
  '◆レコード追加
  For i = 1 To 5
    .AddNew
    .Fields(0).Value = i
    .Fields(1).Value = Choose(i, "A", "B", "C", "D", "E")
    .Fields(2).Value = "Test" & i
    .Fields(3).Value = DateSerial(Year(Date), Month(Date), i)
    .Fields(4).Value = i * 1.5
  Next i
  
  .MoveFirst
End With

'◆ピボットテーブルの設定&作成
strPivotName = "集計結果"
Set objPivotCache = ThisWorkbook.PivotCaches.Add(xlExternal)
Set objPivotCache.Recordset = objRS
objPivotCache.CreatePivotTable ThisWorkbook.Worksheets(1).Range("A1"), strPivotName

'◆ピボットテーブルのフィールドの設定
With ThisWorkbook.Worksheets(1).PivotTables(strPivotName)
  '◆行フィールドの設定
  For i = 1 To 3
    .PivotFields(i).Orientation = xlRowField
    .PivotFields(i).Position = i
    .PivotFields(i).Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
  Next i
  
  '◆列フィールド・合計フィールドの設定
  .PivotFields("日付").Orientation = xlColumnField
  .PivotFields("日付").Position = 1
  
  .PivotFields("値").Orientation = xlDataField
  
End With

'◆オブジェクト変数の解放
objRS.Close
Set objRS = Nothing
Set objPivotCache = Nothing


End Sub


ポイントは、Recordsetプロパティを設定するときにSetステートメントを使うことでしょうか。
Setステートメントを使わないとエラーが出ます。
ピボットテーブルの設定はマクロ記録でコードを取得して改変すると多少楽です。

あと、行フィールドはそのままだと小計行が出てきてしまうので、
SubtotalsプロパティはFalseにしておくとスッキリします。

集計関係サンプルマクロ

項目ごとに集計する Dictionaryオブジェクトでクロス集計

データの集計には配列をよく使います。
配列は便利なのですが、欠点があります。
それは、配列にどんな値があるかがわからないところです。

どんな値が入っているかわからないと、項目ごとに値を集計したい!というときに
困ってしまいます。
そういう時は、Dictionaryオブジェクトを使うと簡単に集計できます。

Dictionaryオブジェクトとは?


VBAで連想配列を使うときに使います。
連想配列とは、インデックス(添字)のかわりに任意の名前(キー)を設定できる配列のことです。
連想配列

Dictionaryオブジェクトの操作


Dictionaryオブジェクトの操作は基本的に以下の3つです。

1.Dictionaryオブジェクトに値を格納する
  Dictionaryオブジェクトに対してAddメソッドを実行します。
  Dictionaryオブジェクト.Add キー名,値
  指定したキー名がない場合は、新たに追加します。

2.Dictionaryオブジェクトから値を取り出す
  Dictionaryオブジェクト(キー名)のValueプロパティを参照します。
  Dictionaryオブジェクト(キー名).Value

3.指定したキー名があるか調べる
  Dictionaryオブジェクトに対してExistsメソッドを実行します。
  指定したキー名がある場合はTrue、ない場合はFalseが返ります。
  Dictionaryオブジェクト.Exists(strKey)

Dictionaryオブジェクトでクロス集計


上のような単純な項目ごとの集計だったらDictionaryオブジェクトを使うより、
SUMIF関数で計算した方が速いですね。
そこで、サンプルではDictionaryオブジェクトを使ってクロス集計をしてみます。

Dictionaryオブジェクトを使うには、「Microsoft Scripting Runtime」への参照設定が必要です。
キー項目は1つしか値を入れられないため、「項目名,日付」をキー項目にして
書き出すときにSplit関数でカンマでデータを区切って、配列に格納しています。

サンプルコード



Sub Dictionaryオブジェクトでクロス集計()

Dim objDIC As New Dictionary
Dim strKey As String
Dim tmp As Variant
Dim N As Variant
Dim i As Long
Dim ii As Long

For i = 1 To 5
  For ii = 1 To 3
    strKey = "Test" & i & "," & Format$(DateSerial(Year(Date), Month(Date), ii), "yyyy/mm/dd")
    If objDIC.Exists(strKey) = False Then
      objDIC.Add strKey, i
    End If
  Next ii
Next i

With ThisWorkbook.Worksheets(1)
  For Each N In objDIC
    i = 2
    ii = 2
    tmp = Split(N, ",")
    '◆行番号取得
    Do Until .Cells(i, ii).Value = ""
      If .Cells(i, "A").Value = tmp(0) Then
        Exit Do
      End If
      i = i + 1
    Loop
    
    '◆列番号取得
    Do Until .Cells(i, ii).Value = ""
      If .Cells(1, ii).Value = CDate(tmp(1)) Then
        Exit Do
      End If
      ii = ii + 1
    Loop
    
    '◆記入
    .Cells(i, "A").Value = tmp(0)
    .Cells(1, ii).Value = tmp(1)
    .Cells(i, ii) = objDIC(N)
    
  Next N

End With

End Sub

VBAエキスパート

VBAエキスパートの勉強方法

仕事でExcelのマクロをそれなり作って知識もあったので、
Excel VBA Standardの勉強は公式テキスト付属の過去問題プログラムを
数回やった程度で、たいした勉強はしていませんでした。

仕事でVBAの勉強をし始めて2年、作ったマクロは20個くらいです。

どちらかというと、Accessの方が不安があったので
AccessVBAスタンダードの勉強ばかりしていました。

Accessは、仕事で2つほどデータベース設計〜完成まで作っていた程度。

勉強は土日のみで、3ヶ月間。(たまにサボりあり)
正直油断していたので、あまりまじめに勉強はしていませんでした。

ExcelVBAスタンダードの勉強方法については、公式のテキストは
お世辞にも読みやすいとはいえないので、わかりやすい入門書で勉強した方がいいかも、と思いました。

私は「かんたんプログラミング Excel2003 VBA 基礎編」で勉強→
ネットで配列・FileSystemObjectなどを勉強→
VBEを使って実践でユーザーフォームを勉強という流れでしたので、
公式テキストは過去問以外ほとんど使いませんでした。

普段からExcelマクロを作っていて知識がある方は、公式テキストは
試験プログラムの操作になれておく、ぐらいの意味合いしかありません。
(過去問題プログラムのシステムが本番試験のプログラムと操作がほぼ同じなので)

AccessはExcelVBAで勉強したことをもとに、ネットでAccessのオブジェクトや
データベースの接続方法(ADO)の知識を勉強していたので、入門書は持っていません。

ですので、公式テキストで勉強しました。

スタンダードは、ベーシックの知識を踏まえた上で、
さらに高度な内容になっているので、基本的なVBAのコードの書き方はのっていません。

いままでVBAを勉強したことのない、まったくの初心者がいきなりスタンダードのテキストを見ても、
たぶんさっぱり理解できないと思うので、今までVBAを勉強したことのない人はベーシックからの方がいいかもしれません。
ベーシックのテキスト持っていないので断言できませんが。

VBAエキスパートの対象がOffce2000〜なのですが、Office2000だと
FileDialogなど、一部動かないものもあるので2002以降で勉強した方がいいです。



VBAエキスパート

VBAエキスパート受験体験記(Access VBA Standard編)

ExcelVBAスタンダードに続いて、AccessVBAスタンダードも受験。

1度受付をすませ、ロッカーの鍵ももうもらっていたので
再度受付した方がいいのか迷っていたところ、2回受ける場合は
2回目も受付しなくてはいけないらしいです。

まあ、1回目と2回目で人が違う!とかいうと大問題なので、当然といえば当然か。

Accessは、仕事でデータベース設計〜完成までを全部1人やって社内システムを作っていたので
楽勝かも!と甘く見ていたのですが、けっこう難しかったです。

選択式の問題でも「これかな?いや、でもこっちも正しいかも・・・・・・」と
思えるものが多くて悩む悩む。

そしてパッと見「同じ問題じゃない?」というのが出てきて、
それの確認に10分ほど費やしてしまいました。
違う問題ならもっとハッキリ区別できるように変えて欲しい〜。

しかも手を上げて試験管の人を呼んでもなかなか来なくて、すごい待たされました。

おかげで時間を大幅ロスし、問題を解き終わったのは残り時間5分を切るというありさま。
しかも最低合格点700点のところ、720点というギリギリっぷり。

その場で合否がわかるのはありがたいですが、試験管の人にも結果が見えちゃうので
あまり成績が悪いとちょっと恥ずかしいですね。

認定証には得点は記載されないので、胸を張って「VBAエキスパート取得しました!」といえます。
たとえギリギリであったとしても!

個人的な感想としては難易度はExcel超簡単、Access難しいだったのですが
合格点は同じだったのが意外でした。

試験問題が難しい回にあたったら苦戦しそうですね。

単に私がExcelVBAよりAccessVBAに慣れていないという理由もあるんでしょうが、
難易度はかなり差があるように感じました。

Accessの方が同じ処理でも記述方法が3パターンくらいあったりして幅広い知識が要求されることや、Excelより普段使わない機能が多かった、というのも原因でしょうか。

ExcelVBAスタンダードは自分で何も見ないでにコードを書ける方なら
たいして勉強しなくても合格できますが、
AccessVBAスタンダードはしっかり勉強しておいた方がいいですね。

試験を受けてから2週間後くらいに認定証がきます。
結果レポートには4〜6週以内に届くと書いてあったから、
意外に早くてビックリしました。

ExcelVBAスタンダードとAccessVBAスタンダードと両方受かっていれば、
クラウンの証明書も一緒に送られてきます。

なくしたら再発行料3000円らしいです。

VBAエキスパート

VBAエキスパート受験記(Excel VBA Standard編)

VBAエキスパートという資格試験を受けてきました。

Officeの資格試験といえば、マクロソフト オフィス スペシャリスト(MOS)が有名ですが、MOSにはVBAによるマクロの作成というのは範囲に含まれていません。

VBAエキスパートは、マイクロソフトの協賛で、
株式会社オデッセイ コミュニケーションズというところが行っている資格試験です。

MOSは簡単すぎて誰にでも取れるというし、あまり実力の認定にはならないのでは?ということもあって取ってなかったのですが、1つくらいはOffice系の資格を持っておくのもいいかな〜ということでVBAエキスパートを受けてみました。

VBAエキスパートは、BasicとStandardの2レベル×ExcelとAccessの2種類があります。
それに、より開発者向けのVBA Professional Office 2003という試験があり、全部で5種類の試験があります。

ExcelVBAスタンダードとAccess VBAスタンダードを両方取得すると、
同時にスタンダードクラウンという称号も認定されます。

そんなわけで2010年某月、ExcelVBAスタンダードとAccessVBAスタンダードを受けてきました。
受験したときの様子を、書ける範囲で書いてみようと思います。

本当ならBasicから受けた方がいいのでしょうが、
受験料が1万越えと高いのでExcel、Accessともにスタンダード1発勝負!

試験会場はオデッセイテスティングセンター有楽町。
日比谷駅から徒歩15分程度(途中で道に迷ったので、迷わなければ徒歩10分くらい?)
意外と遠かったです。

ビルの階段を降りてすぐ右側が試験会場になっています。
VBAエキスパートのポスターが貼ってあるのですぐわかります。

試験はやはり、若い人が多く受けていました。
受付には4人がけのテーブルが3つとソファーが置かれていましたが、ほぼ満席。

受付で名前を記入して呼ばれるのを待つこと数分、
チケットを見せて、説明資料とロッカーの鍵をもらいます。

まずは1回戦目、ExcelVBAスタンダードから。
試験科目ごとに微妙に制限時間が違ったりするのですが、
ExcelVBAスタンダードは公式サイトに書いてあるとおり、50分で40問。

試験は結構簡単で、一通り終わったところで残り30分。
2回見直しをして残り15分で終了。
試験が終わったら、その場で結果が表示されるので
手を上げて試験官の人を呼び、結果を印刷してもらいます。

試験の難易度はそんなにでもなかったため、満点(1000点)を
ひそかに狙っていたのですが、得点は978点でした。おしい。

結果レポートは最低合格点と自分の得点、セクションごとの正解率ぐらいしかでないので、
どの問題を間違ったかまではわかりません。

復習にはあまり役に立たないので、1発合格を目指したいところです。


お昼をはさむばあいは、同じフロアが飲食店街になっているので
適当なところでとればいいでしょう。

私は試験会場近くのスープのお店でいただきました。

バグ

【トラブル】InStr・InStrRev関数で結果が正しく取得されない

マクロを組んでいると、たまにInStr関数やInStrRev関数の結果が
正しく取得されない時があるので検証してみました。
サンプルは○○-○○-○○-09-****というような番号から、
****だけを抜き出すというマクロです。

strWord = 〜の部分をどちらか一方をコメントにしてそれぞれ実行すると、
「strWord = "○○-〜」の方は正常に取得できるのに、
「strWord = "ガ○-〜」の方は1文字分ずれてしまいます。

サンプルコード1



Sub NumCheck1()
 Dim strWord As String
 Dim check As String '「****」のチェック用
 Dim i As Long

 strWord = "○○-○○-○○-09-****" '正常
 strWord = "ガ○-○○-○○-09-****" 'ずれる

 '◆管理番号の「****」が数字に直っているかチェック
 i = InStrRev(StrConv(strWord, vbNarrow), "-")

 If i > 0 Then
  check = Mid$(strWord, i + 1, 4)
 End If

 '◇確認用
 MsgBox check

 If check = "****" Then
  MsgBox "管理番号の「****」を数字に直してください。"
 End If
End Sub


半角カナの濁音・半濁音は文字部分と濁点・半濁点の部分が分かれているために、このような状況になるらしいです。
たとえば、「ガ」を半角にすると、半角の「カ」と濁点で2文字になります。

Public Sub ConvertTest()
 Dim strWord As String
 strWord = "ガ"
 MsgBox Len(strWord)       '全角カタカナは1文字
 MsgBox Len(StrConv(strWord, vbNarrow)) '半角カタカナの濁音・半濁音は2文字
End Sub

文字数が増えるのは濁音・半濁音の部分だけなので、単純に文字数が2倍になるというわけではないのがやっかいです。

まとめ(文字化け対策のため画像です)
katakana01.png

記事にコメントで指摘いただきましたとおり、文字位置を半角で取得したらMid関数で取り出すときも半角に変換した文字を使うことで対応できます。

Public Sub NumCheck2()
 Dim strWideWord As String
 Dim strNarrowWord As String
 Dim check As String '「****」のチェック用
 Dim i As Long

 strWideWord = "○○-○○-○○-09-****" '正常
 strWideWord = "ガ○-○○-○○-09-****" 'ずれる

 '◆半角に変換
 strNarrowWord = StrConv(strWideWord, vbNarrow)

 '◆管理番号の「****」が数字に直っているかチェック
 i = InStrRev(strNarrowWord, "-")

 If i > 0 Then
  check = Mid$(strNarrowWord, i + 1, 4)
 End If

 '◇確認用
 MsgBox check

 If check = "****" Then
  MsgBox "管理番号の「****」を数字に直してください。"
 End If
End Sub


参考資料:
[ACC2002] Access プロジェクトで VBA の InStr 関数が返す値が間違っている


ExcelVBAサンプルマクロ

ファイルをコピーする

FileCopyステートメントを使うとファイルをコピーできます。

◆FileCopyステートメント
FileCopy コピー元のファイルパス,コピー先のファイルのパス

ただし、FileCopyステートメントはコピーしようとしているファイルが使用中だと
「実行時エラー70」が発生したり、すでに同じファイルがある場合の上書き設定ができない
(必ず上書きされる)など使い勝手がちょっと悪いです。

そこで、FileSystemObjectのCopyFileメソッドを使うといいでしょう。

◆CopyFileメソッド(FileSystemObject)
FileSystemObject.CopyFile コピー元ファイル,コピー先ファイル,[上書き設定]

省略可能な引数として、第3引数にOverWrite(上書き)の設定があります。
同名のファイルがある場合、Trueにした場合は上書きし、
Falseにした場合は実行時エラー58が発生します。

サンプルコード



Sub FSOでファイルコピー()

Dim FSO As Object
Dim strFilePath As String
Dim strFileName As String

strFilePath = ThisWorkbook.Path & "¥"
strFileName = "Book1.xls"

Set FSO = CreateObject("Scripting.FileSystemObject")
FSO.CopyFile strFilePath & strFileName, strFilePath & "Copy1.xls", True

End Sub



印刷関係サンプルマクロ

拡張子を気にせず印刷する

私の職場では会議資料などを印刷する時、Excelファイル以外にも
WordファイルやらPDFファイルやらが混ざっている事があります。

そこで拡張子を気にせず、一気に印刷するマクロを作ってみました。
WindowsAPIを使って、関連付けられたアプリケーションで印刷を行います。

サンプルコード1



'◆APIの宣言
Declare Function ShellExecute Lib "SHELL32" Alias "ShellExecuteA" _
  (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _
   ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Sub ファイル印刷1()
  Dim strPath As String
  Dim strName As String
  
  '◆パス指定
  strPath = "C:" & "¥"
  strName = Dir(strPath & "*")
  
  '◆フォルダ内のファイルすべて印刷
  Do Until strName = ""
    Call ShellExecute(Application.hwnd, "print", strPath & strName, vbNullString, "", 0)
    strName = Dir()
  Loop
End Sub


変数strPathで指定したフォルダ内のファイルをすべて印刷します。

欠点は、Dir関数のファイル名を取得する順番が自分で決められないのと、
開く前のメッセージ(すでにファイルが開かれていた時の「読み取り専用で開きますか?」というメッセージや「読み取り専用を推奨する」にしていた場合のメッセージなど)が非表示にできない事。

順番を決めて印刷したい時は、Bookに下記のようなリストを作って
順番に印刷していけばいいでしょう。
ついでにパスを書く欄も作っておけば、違うフォルダにあるファイルも順番に印刷できます。



 AB
1フォルダファイル名
2C:¥Test1Test1.doc
3C:¥Test2Test2.pdf
4C:¥Test3Test3.xls


サンプルコード2



'◆APIの宣言
Declare Function ShellExecute Lib "SHELL32" Alias "ShellExecuteA" _
  (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _
   ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Sub ファイル印刷2() ' ◆リストにあるファイルをすべて印刷

  Dim strPath As String
  Dim strName As String
  Dim lngRow As Long
  
  lngRow = 2

  With ThisWorkbook.Worksheets(1)
    Do Until .Cells(lngRow, 1).Value = ""
      '◆パス指定
      strPath = .Cells(lngRow, 1).Value & "¥"
      strName = .Cells(lngRow, 2).Value
    
      '◆印刷
      Call ShellExecute(Application.hwnd, "print", strPath & strName, vbNullString, "", 0)
    
      lngRow = lngRow + 1
    Loop
  End With

End Sub

ちなみに、存在しないファイルを印刷しようとするとエラーメッセージも何も出ずに次に進むので、もしフォルダやファイル名が変更される可能性があるなら、事前に自分でDir関数を使ってファイルが存在するかチェックするといいでしょう。

ExcelVBAサンプルマクロ

オートフィルターがかかっていればすべてのデータを表示

フィルターで抽出した状態から全表示するにはShowAllDataメソッドを
使いますが、オートフィルターがかかっていない時に実行すると
「実行時エラー'1004':WorkSheetクラスのShowAllDataメソッドが失敗しました」が発生します。

そこで、事前にFilterModeプロパティでオートフィルターがかかっているか判定する必要があります。

サンプルコード



Sub すべてのデータを表示()

With ThisWorkbook.Worksheets(1)
 If .FilterMode = True Then
  .ShowAllData
 End If
End With

End Sub


ExcelVBAサンプルマクロ

入力規則に合ったデータが入力されているか確認する

入力規則ではユーザーが入力できる値を制限する機能ですが、
コピーで貼り付けた場合は、入力規則外のデータも貼付けできてしまいます。

そのため、入力規則をかけていても、入力規則に合ったデータが
入力されているかどうかチェックする必要があります。

入力規則に合ったデータが入力されているかどうかは
ValidationオブジェクトのValueプロパティの値でわかります。

入力規則がかかっていない、もしくは入力規則に合う場合はTrue、
入力規則に合わない場合はFalseとなります。

サンプルコード



Sub 入力規則チェック()

Dim objcell As Range

For Each objcell In ThisWorkbook.Worksheets(1).Range("A1:B10")
 If objcell.Validation.Value = False Then
  MsgBox objcell.Address(False, False) & "は入力規則に合っていません。"
 End If
 
Next objcell

End Sub


<<前の10件  1 2 3 4 5..  次の10件>>


Powered by Seesaa
×

この広告は1年以上新しい記事の投稿がないブログに表示されております。