topimg.jpg


スポンサーサイト

上記の広告は1ヶ月以上更新のないブログに表示されています。
新しい記事を書く事で広告が消せます。
  1. --/--/--(--) --:--:--|
  2. スポンサー広告

複数のエクセルファイルから必要情報を1つの表に抽出するマクロ

複数のエクセルファイルから、必要なデータを抜き出して、サマリとして1つの表にまとめるマクロをつくってみた。抽出したデータには、各行に抽出元となったファイル名とシート名も付与している。これの使いどころしては、「データが複数のエクセルファイルに分散しているため、一元管理する必要がある」ときだろうか。エクセルファイルの数が多いと、手作業で行うのはなかなか辛いし、ミスもでる。


サマリマクロ

●ダウンロード先
サマリブック
(エクセルファイルがFC2ブログではアップできなかったため、拡張子を.txtに変更しています。ダウンロード後、拡張子を.txtから.xlsにリネームしてください。)

●コード
コードは下記のとおり。例のごとく、インデントがないため見にくいが。


Sub MakeSamary()
'変数の宣言
Dim BaseCell1 As String
Dim SamaryBook1 As Workbook
Dim InputBook1 As Workbook
Dim InputSheetName1(20) As String
Dim InputColumnName1(20) As String

'変数への代入
BaseCell1 = "D4"
Set SamaryBook1 = ThisWorkbook

For i = 0 To 19
InputSheetName1(i) = Range(BaseCell1).Offset(-2, i).Value 'シート名の取得
Next i

For i = 0 To 19
InputColumnName1(i) = Range(BaseCell1).Offset(1, i).Value '列名の取得
Next i

'開いている全ブックに対して、ColumnSelectを適用
For Each Workbook In Workbooks
With Workbook
.Activate
Set InputBook1 = ActiveWorkbook
Call ColumnSelect(SamaryBook1, InputBook1, InputSheetName1, InputColumnName1, BaseCell1)
End With
Next

End Sub






Sub ColumnSelect(SamaryBook As Workbook, InputBook As Workbook, InputSheetName() As String, InputColumnName() As String, BaseCell As String)
'シート名1からシート名20まで順に処理
For k = 0 To 19
InputBook.Activate
'インプットブックに、指定したシート名と同名のシートが含まれていれば、後続の処理を行う
If ExistSheet(InputSheetName(k)) Then
'列名1から列名20までを順に処理。途中で列名が空白になっていれば、ループ処置を解除
For i = 0 To 19
If InputColumnName(i) = "" Then
Exit For
End If

'指定した列名を含むカラムをインプットブックからコピーしてくる
InputBook.Activate
Worksheets(InputSheetName(k)).Select
Cells.Find(What:=InputColumnName(i)).Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy

'コピーしたカラムをサマリブックに貼り付け
SamaryBook.Activate
Range(BaseCell).Offset(0, i).Select
Selection.End(xlDown).Offset(1, 0).Select
ActiveSheet.Paste
Next i

'サマリブックのシート名列への記入
Range(BaseCell).Select
Selection.End(xlDown).Offset(0, -1).Select
Range(Selection, Selection.End(xlUp).Offset(1, 0)).Select
Selection.Value = InputSheetName(k)

'サマリブックのファイル名列への記入
Selection.End(xlDown).Offset(0, -1).Select
Range(Selection, Selection.End(xlUp).Offset(1, 0)).Select
Selection.Value = InputBook.Name
End If
SamaryBook.Activate
Next k
End Sub






'引数 SheetName のシートが実際にあるかチェックする
'http://www.k1simplify.com/vba/tipsleaf/leaf14.html より引用
Function ExistSheet(SheetName) As Boolean
Dim i, cnt As Integer
cnt = Sheets.Count
ExistSheet = False
For i = 1 To cnt
If Sheets(i).Name = SheetName Then
ExistSheet = True
Exit For
End If
Next
End Function

テーマ:ソフトウェア - ジャンル:コンピュータ

  1. 2011/09/11(日) 07:18:39|
  2. MSOffice
  3. | トラックバック:0
  4. | コメント:1

Excelマクロでオブジェクト型変数を扱うときのお作法

マクロの基礎勉強。

●オブジェクト型変数の利用例
・一般的な型の場合
Dim x As Integer
x = 10

・オブジェクト型の場合
Dim x As Range
Set x = Range("A1") ※Setステートメントは、エクセルの場所情報をオブジェクトに格納する
x.Value = 20 ※オブジェクトのプロパティ操作
x.Delete ※オブジェクトのメソッド操作

●一般的なオブジェクト型の種類
・アプリケーション Application
・ブック Workbook
・ワークシート Worksheet
・セル Range
・全ブック Workbooks
・全ワークシート Worksheets


●参考
オブジェクトとは
http://www.officepro.jp/excelvba/object/index1.html

テーマ:ソフトウェア - ジャンル:コンピュータ

  1. 2011/09/11(日) 00:37:02|
  2. MSOffice
  3. | トラックバック:0
  4. | コメント:1

エクセルで作成したグラフ等を画像ファイルで保存する

対象のエクセルファイルを開き、名前を付けて保存→「ファイルの種類」を「Webページ(*.htm; *.html)」にして保存する。保存先にファイル名と同様のフォルダが作成される。画像ファイルはその中に含まれている。


無題
  1. 2011/06/08(水) 03:20:11|
  2. MSOffice
  3. | トラックバック:0
  4. | コメント:0

ピボットテーブルで項目の順序を入れ替える

行ラベル(もしくは列ラベル)の各項目を選択→右クリック→移動
※確認環境:Excel2007

テーマ:ソフトウェア - ジャンル:コンピュータ

  1. 2011/05/29(日) 16:08:49|
  2. MSOffice
  3. | トラックバック:0
  4. | コメント:0

その月の第何週かをエクセルで計算

A2に「2011/1/1」のような日付データが入っている場合、B2セルに以下を入力。

「=WEEKNUM(A2)-WEEKNUM(DATE(YEAR(A2),MONTH(A2),1))+1」

WEEKNUM(A2)・・・A2がその年の第何週か
WEEKNUM(DATE(YEAR(A2),MONTH(A2),1))・・・A2の月の1日目が、その年の第何週か


参考
月の第何週かを調べるには?
http://www.relief.jp/itnote/archives/003556.php

テーマ:ソフトウェア - ジャンル:コンピュータ

  1. 2011/05/29(日) 16:08:03|
  2. MSOffice
  3. | トラックバック:0
  4. | コメント:0
前のページ 次のページ
上記広告は1ヶ月以上更新のないブログに表示されています。新しい記事を書くことで広告を消せます。