| |
▼ニャンソ さん：
>間違えです。Ｚになります。
>今までのですと、従業員番号で行っていました。
了解です。
>加えてBook1の元データですが、また変更するそうです…
金額欄が Y,Z列とか、
Book2 のどの行に 印刷データを値貼り付けするのか？ とか、
そういうことは「変数」 なので、変わってもいいようにマクロの
ほうで対応しておけばいいですよ。
そういえば、送られてくるデータブックも当然 Book名が都度
変わりますね？
前回の (kanabun案) を少し変更して、Book1の名前をマクロコード
上でいちいち変更しなくてもすむように、マクロを実行するときは
送られてきたデータブックを前面にして（アクティブにして）スタート
すればすむようにしました。
> Book1-1が他部署より送られてきたデータになります。
なので、ここから マクロブックの「Temp」シートに 必要な3地区データ
を転送し、「Temp」シートにコピーされたデータについてだけグループ
番号の書き込みをすることにします。要は、並び替えのキーにグループ
番号が必要なだけなので、ってことです。
そのほかのレイアウト関係は 前回と同じ前提です。
'---------------------------------------- 標準モジュール
Option Explicit
Private Book1 As Workbook
Private Book2 As Workbook
Private Book3 As Workbook
Sub Try1()
'◆送られてきたBookをアクティブにして実行してください
Set Book1 = ActiveWorkbook '送られてきたデータブック
Set Book2 = Workbooks("Book2.xls") '印刷シート
Set Book3 = ThisWorkbook 'このマクロBook(Group名一覧を含む)
If Book1 Is Book2 Then
MsgBox "送られてきたBookを前面にして実行", vbCritical
Exit Sub
End If
If Book1 Is Book3 Then
MsgBox "送られてきたBookを前面にして実行", vbCritical
Exit Sub
End If
'>1.処理する地区のみ（3地区）フィルタにて表示し別シートへコピペ
'まず Book1の2つのシートから 必要な3地区データのみ AdvancedFilterにて _
Book3.[Temp] へ抽出転記します｡
Dim shtA As Worksheet 'Book1 のSheet1
Dim shtP As Worksheet 'Book2の印刷用シート
Dim shtL As Worksheet 'Book3の「List」Sheet
Dim nSheet As Long
Dim nRow As Long: nRow = 1
Dim c As Range, cc As Range
Set shtA = Book1.Sheets(1)
Set shtL = Book3.Worksheets("List")
Set c = shtL.Range("G1")
Set c = Range(c, c.End(xlDown)) 'CriteriaRange(抽出したい地区名リスト)
Set shtP = Book2.Sheets(1)
With Book3.Worksheets("Temp") 'Temp Sheetに必要データだけ転記
.UsedRange.Clear
'列見出しのコピー
.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) '別シートに抽出
'>2.そこに Book3[List] からグループ番号をコピペ
'shtP A列にグループ番号 埋め込み
Dim i&, v
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 '「申請日」列を挿入 空白
Set cc = c.CurrentRegion.Resize(, 8) '8列
'◆A:Group番号 D:従業員NB E:員名 F:申請日 G:申請金額 H:実金額
' 4.グループ番号(1〜12)別に 印刷シート[B8]へ 値のみ転記・印刷する
For i = 1 To 12
cc.Columns(1).AutoFilter 1, i
If cc.Columns(1).SpecialCells(xlVisible).Count > 1 Then
shtP.[B8:F40].ClearContents '←表罫線範囲クリア
Intersect(cc.Offset(1), cc.Columns("D:H")).Copy
shtP.[B8].PasteSpecial xlValues
'>5.合計金額（申請金額・実金額それぞれ）を算出 (数式入力)
'----------- 集計行が不明なので割愛 ------------
'印刷します
shtP.PrintPreview '⇒ 実用時には .PrintOut に変更
End If
cc.Columns(1).AutoFilter
Next
End With
End Sub
Book3(マクロブック)シート「Temp」
'>3.グループ番号・従業員番号順に並び変え
後の表はこんな感じになります。
-----------------------------------------------------------------
Ａ Ｂ Ｃ Ｄ Ｅ Ｆ Ｇ Ｈ
-----------------------------------------------------------------
Group番号 県名 地区 従業員番号 氏名 申請金額 実金額
1 三重 C地区 005 新井 87 73
2 岐阜 B地区 015 上野 81 73
2 岐阜 B地区 017 遠藤 90 51
3 三重 C地区 020 大貫 87 36
3 愛知 A地区 024 岡田 63 100
4 愛知 A地区 030 加藤 73 44
4 三重 C地区 032 神山 91 32
5 愛知 A地区 034 川島 73 44
：
：
|
|
kanabun
- 12/12/29(土) 9:31 -
