| |
▼kanabun さん：
こんばんは。
>それで、次に、 こちらが 知りたいのは
>
>Step 1. と Step 2. は どのようなコードを書いて成功されたのでしょうか？
Option Explicit
Private Book4 As Workbook
Private Book5 As Workbook
Private Book6 As Workbook
Sub Try1()
'◆送られてきたBookをアクティブにして実行してください
Set Book4 = ActiveWorkbook '送られてきたデータブック
Set Book5 = Workbooks("Book5.xlsx") '印刷シート
Set Book6 = ThisWorkbook 'このマクロBook(Group名一覧を含む)
If Book4 Is Book5 Then
MsgBox "送られてきたBookを前面にして実行", vbCritical
Exit Sub
End If
If Book4 Is Book6 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 = Book4.Sheets(1)
Set shtL = Book6.Worksheets("List")
Set c = shtL.Range("DT1")
Set c = Range(c, c.End(xlDown)) 'CriteriaRange(抽出したい地区名リスト)
Set shtP = Book5.Sheets(1)
With Book6.Worksheets("Temp") 'Temp Sheetに必要データだけ転記
.UsedRange.Clear
'列見出しのコピー
.Cells(nRow, 1) = "Group番号" 'あとで Book3より引用
.Cells(nRow, 2) = shtA.[C4].Value '県名
.Cells(nRow, 3) = shtA.[D4].Value '地区★
.Cells(nRow, 4) = shtA.[F4].Value '従業員番号-----+
.Cells(nRow, 5) = shtA.[G4].Value '従業員氏名 |印刷項目
.Cells(nRow, 6) = shtA.[Y4].Value '申請金額 |
.Cells(nRow, 7) = shtA.[Z4].Value '実金額 -------+
With shtA
Set cc = .Range("C4", .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.PrintOut '⇒ 実用時には .PrintOut に変更
End If
cc.Columns(1).AutoFilter
Next
End With
End Sub
kanabunさんに考えて頂いたコードを
Book1=Book4
Book2=Book5
Book3=Book6
G1=DT1
Book4の見出し行が「4」
に変更しました。
上記コードでStep 1. と Step 2.出来ました。
>>3.Boo3のTempシートを 順番に あるグループ？だけ Autofilterで値Copyして
>> 印刷に回す（Book2で）
>
>↑このStep がまだ 成功していないのは、何が障害になっているのでしょうか？
'>5.合計金額（申請金額・実金額それぞれ）を算出 (数式入力)
'----------- 集計行が不明なので割愛 ------------
'印刷します
shtP.PrintPreview '⇒ 実用時には .PrintOut に変更
のところを
shtP.PrintOut '⇒ 実用時には .PrintOut に変更
と変更したのですが、印刷されず…
Step 2.で実行が完了してしまいます。
特にエラー等出ないので、何故なのか良く分かりません。
よろしくお願い致します。
|
|
ニャンソ
- 13/1/14(月) 20:07 -
