| |
▼UO3 さん：
UO3 さん、分かりやすい解説ありがとうございます。
UO3さんの考えを参考にして、以下の (kanabun案) 考えてみました。
やはりいくつか想定があります。
使うBook は送られてきたデータブック、
印刷用Book, それと 標準モジュールに以下のマクロがあるマクロブック
の３つとします。
この3つを 変数では Book1, Book2, Book3 とします。
Book1の各シートは
Ａ・Ｂ・Ｃ・Ｄ・Ｅ・Ｆ・Ｇ・までが 7行目にタイトルで
空白・通番・県名・地区・グループ番号・従業員番号・従業員名
・Ｈ〜Ｘ・Ｙ・Ｚ 列が
・過去申請金額・申請金額・実金額 ← 7行目
となっているものとします。
Book3（マクロの書いてあるブック）には、
「List」という名のシートと
「Temp」という名のシートがあります。
「Temp」シートは作業用一時シートで、Book1の必要な
データ（既定の3地区データのみ）をここへコピーし、
印刷用に加工するのに利用します。
「List」シートには [A列]から
県名・地区・グループ名・従業員番号・従業員名
が(データは2行目から)書いてあります。
また
「List」シートのG列には 抽出する「地区名」がリストされて
いるものとします。↓(これが CriteriaRange です)
G列
1 地区
2 A地区
3 B地区
4 C地区
'---------------------------------------- 標準モジュール
Option Explicit
Private Book1 As Workbook '送られてきたデータブック
Private Book2 As Workbook '印刷シート
Private Book3 As Workbook 'グループ名一覧を含むマクロブック
Sub Try1()
Set Book1 = Workbooks("Book1.xls") '◆実際のBook名に変更
Set Book2 = Workbooks("Book2.xls") '◆実際のBook名に変更
Set Book3 = ThisWorkbook
'まず Book1の2つのシートから 必要な3地区データのみ _
Book3.[Temp]へ抽出転記します。
'>1. 私が処理する地区のみ（3地区）フィルタにて表示し別シートへコピペ
Dim shtA As Worksheet
Dim shtL As Worksheet
Dim nSheet As Long
Dim nRow As Long: nRow = 1
Dim c As Range, cc As Range
Set shtL = Book3.Worksheets("List") '◆実際のSheet名に変更
Set c = shtL.Range("G1")
Set c = Range(c, c.End(xlDown)) 'CriteriaRange(抽出したい地区名リスト)
With Book3.Worksheets("Temp") '一時シートに必要データだけ転記
.UsedRange.Clear
For nSheet = 1 To 2
Set shtA = Book1.Sheets(nSheet)
'列見出しのコピー
.Cells(nRow, 1) = "Group番号" 'あとで Book3より引用
.Cells(nRow, 2) = shtA.[C7].Value '県名
.Cells(nRow, 3) = shtA.[D7].Value '地区★
.Cells(nRow, 4) = shtA.[F7].Value '従業員番号-----+
.Cells(nRow, 5) = shtA.[G7].Value '従業員氏名 |印刷項目
.Cells(nRow, 6) = shtA.[Y7].Value '申請金額 |
.Cells(nRow, 7) = shtA.[Z7].Value '実金額 -------+
With shtA
Set cc = .Range("C7", .Cells(.Rows.Count, "C").End(xlUp))
End With
cc.Resize(, 24).AdvancedFilter _
xlFilterCopy, _
CriteriaRange:=c, _
CopyToRange:=.Cells(nRow, 2).Resize(, 6)
If nSheet = 1 Then _
nRow = .Cells(.Rows.Count, 2).End(xlUp).Row + 1
Next
.Rows(nRow).Delete '2回目の列見出し行を削除
'>2.そこにBook3からグループ番号をコピペ
'A列にグループ番号 埋め込み
Dim i&, v, s$
Dim dic As Object
Set dic = CreateObject("Scripting.Dictionary")
v = shtL.[A1].CurrentRegion.Value 'Group番号 ⇔ 従業員番号
For i = 2 To UBound(v)
dic(v(i, 4)) = v(i, 3)
Next
Set c = .Range("B2", .Cells(.Rows.Count, "B").End(xlUp))
v = c.Offset(, 2).Value '従業員番号データ
ReDim grp(1 To UBound(v), 1 To 1)
For i = 1 To UBound(v)
If dic.Exists(v(i, 1)) Then
grp(i, 1) = dic(v(i, 1))
End If
Next
.[A2].Resize(UBound(v)).Value = grp
'>3.グループ番号・従業員番号順に並び変え
With c.CurrentRegion
.Sort Key1:=.Columns(1), Key2:=.Columns(4), _
Header:=xlYes
End With
.Columns(6).Insert '「申請日」列を挿入 空白
'グループ番号1〜12まで 1番号ずつ Book2へ 値転記・印刷
Set cc = c.CurrentRegion
'A:Group番号 D:従業員NB E:員名 F:申請日 G:申請金額 H:実金額
For i = 1 To 12
'>4.グループ番号(i)のみ表示しBook2 [B8]へ値コピー
cc.Columns(1).AutoFilter 1, i
If cc.Columns(1).SpecialCells(xlVisible).Count > 1 Then
Book2.Sheets(1).[B8:F47].ClearContents '罫線範囲クリア
Intersect(cc.Offset(1), cc.Columns("D:H")).Copy
Book2.Sheets(1).[B8].PasteSpecial xlValues
'> 5.合計金額（申請金額・実金額それぞれ）を算出 (数式入力)
'----------- 行が不明なので割愛 ------------
'印刷します
Book2.Sheets(1).PrintPreview '⇒ .PrintOutに
End If
cc.Columns(1).AutoFilter
Next
End With
End Sub
------------
グループ番号は何に紐づけられているか？ これは UO3 さん同様、
従業員番号がグループ化されているものと仮定しています。
なので、そうでないばあいは、コードを編集する必要があります。
できれば、ごく簡単な Book1-1 Book1-2 データで,
Step実行しながら、コードの1行が何をしているのか、ワークシート
画面の変化と見くらべながら、確認していくと理解が早まると思います。
|
|
kanabun
- 12/12/28(金) 19:37 -
