| |
記憶マクロではなく、マクロ記録です。
これだって、十分使えるものになるはずですし、
VBAの立派な教材になります。
（下記のコードも、マクロ記録を修正したものです。）
Sheet1をSheet2のような形にいったん変換して、
Sheet2を ピボットテーブルにすれば
Sheet3のような表が得られます。
【Sheet1】
A B C D E F
1 分類 1. 2. 3. パターン 対象外
2 A 1 あ
3 A 1 あ
4 A 1 い
5 B 1 1 う
6 B 1 S
7 C 1
【Sheet2】
A列 B列 C列
1 分類 種類 パターン
2 A 1 あ
3 A 1 あ
4 A 2 い
5 B 2 う
6 B 3 う
7 B 2 対象外
8 C 3 調査中
【Sheet3】
列ラベル
行ラベル 1 2 3
A
あ 2
い 1
う
対象外
調査中
B
あ
い
う 1 1
対象外 1
調査中
C
あ
い
う
対象外
調査中 1
(コード参考例）
Option Explicit
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim ws3 As Worksheet
Sub test()
Dim category As String
Dim goods As String
Dim pattern As String
Dim k As Long, j As Long
Dim p As Long
Set ws1 = Worksheets("Sheet1")
Set ws2 = Worksheets("Sheet2")
Set ws3 = Worksheets("Sheet3")
p = 1
'(1)Sheet2に別フォーマットで転記
For k = 2 To ws1.Range("A1").End(xlDown).Row
category = ws1.Cells(k, 1).Text
pattern = getPattern(k)
For j = 2 To 4
If ws1.Cells(k, j).Value = 1 Then
goods = getGoods(j)
p = p + 1
Call writeToSheet2(p, category, goods, pattern)
End If
Next
Next
'(2)それをもとにピボットテーブルをSheet3に作成
makePivotTable
End Sub
Function getPattern(k As Long) As String
If Len(ws1.Cells(k, 5).Value) > 0 Then
getPattern = ws1.Cells(k, 5).Value
ElseIf ws1.Cells(k, 6).Value = "S" Then
getPattern = "対象外"
Else
getPattern = "調査中"
End If
End Function
Function getGoods(j As Long) As String
getGoods = CStr(j - 1)
End Function
Function writeToSheet2(p As Long, category As String, goods As String, pattern As String)
ws2.Cells(p, 1).Value = category
ws2.Cells(p, 2).Value = goods
ws2.Cells(p, 3).Value = pattern
End Function
Sub makePivotTable()
Dim myRange As Range
Dim pvCache
Dim pbTable
Set myRange = ws2.Range("A1").CurrentRegion
Set pvCache = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, _
SourceData:=myRange.Address(external:=True), _
Version:=xlPivotTableVersion14)
Set pbTable = pvCache.CreatePivotTable _
(TableDestination:=ws3.Range("A1"), _
DefaultVersion:=xlPivotTableVersion14)
With pbTable
With .PivotFields("分類")
.Orientation = xlRowField
.Position = 1
End With
With .PivotFields("パターン")
.Orientation = xlRowField
.Position = 2
End With
With .PivotFields("種類")
.Orientation = xlColumnField
.Position = 1
End With
.AddDataField .PivotFields("種類"), "データの個数 / 種類", xlCount
With .PivotFields("種類")
.Orientation = xlColumnField
.Position = 1
End With
.SortUsingCustomLists = False
.PivotFields("分類").AutoSort xlAscending, "分類"
.PivotFields("パターン").ShowAllItems = True
.ColumnGrand = False
.RowGrand = False
.PivotFields("分類").Subtotals = Array( _
False, False, False, False, False, False, False, False, False, False, False, False)
End With
End Sub
|
|
γ
- 14/7/13(日) 23:07 -
