| |
▼jun さん：
>はぁ・・？？
という表現はレス気なくす人もいますから気をつけたほうがいいですよ。
あとヨビステもね。や、冗談やけど^ ^
ほんとはScripting.Dictionaryの前に、配列について理解したほうが良いです。
Sub vntsample()
'yのmatchキーは手抜きでA列のみ
Dim sh As Worksheet
Dim i As Long
Dim n As Long
Dim v, w, x, y
Set sh = Sheets("sheet2")
sh.UsedRange.Clear
With Sheets("sheet1").Range("A2").CurrentRegion
.Resize(, 2).AdvancedFilter _
Action:=xlFilterCopy, CopyToRange:=sh.Range("A1"), Unique:=True
.Columns(3).AdvancedFilter _
Action:=xlFilterInPlace, Unique:=True
.Columns(3).Offset(1).SpecialCells(xlCellTypeVisible).Copy
sh.Range("C1").PasteSpecial Paste:=xlPasteValues, Transpose:=True
Application.CutCopyMode = False
.Worksheet.ShowAllData
v = .Resize(.Rows.Count - 1).Offset(1).Value
End With
With sh.Range("A1").CurrentRegion
n = .Columns.Count + 1
w = .Resize(, n).Value
w(1, n) = "不良合計"
For i = 1 To UBound(v)
With Application
y = .Match(v(i, 1), .Index(w, 0, 1), 0)
x = .Match(v(i, 3), .Index(w, 1, 0), 0)
End With
If Not IsError(y) And Not IsError(x) Then
w(y, x) = w(y, x) + v(i, 4)
w(y, n) = w(y, n) + v(i, 4)
End If
Next i
.Resize(, n).Value = w
End With
Set sh = Nothing
End Sub
↓これはピボットサンプル。
Sub pvtsample()
Dim r As Range
Application.ScreenUpdating = False
Set r = Sheets("sheet1").Range("A2").CurrentRegion
With ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, _
SourceData:=r.Address(external:=True)). _
CreatePivotTable(TableDestination:="")
.Format xlPTNone
.AddFields RowFields:=Array(r.Cells(1).Value, r.Cells(2).Value), _
ColumnFields:=r.Cells(3).Value
With .PivotFields(r.Cells(4).Value)
.Orientation = xlDataField
.Function = xlSum
End With
.PivotFields(r.Cells(1).Value).Subtotals(1) = False
With .TableRange1
.Copy
.PasteSpecial Paste:=xlPasteValues
.Interior.ColorIndex = xlNone
.Rows(1).Delete
.BorderAround Weight:=xlThin
.Borders(xlInsideVertical).Weight = xlThin
.Borders(xlInsideHorizontal).Weight = xlThin
End With
End With
Set r = Nothing
Application.ScreenUpdating = True
End Sub
↓これは蛇足。
Sub fncsample()
Dim sh As Worksheet
Dim s As String
Set sh = Sheets("sheet2")
sh.UsedRange.Clear
With Sheets("sheet1").Range("A2").CurrentRegion
.Resize(, 2).AdvancedFilter _
Action:=xlFilterCopy, CopyToRange:=sh.Range("A1"), Unique:=True
.Columns(3).AdvancedFilter _
Action:=xlFilterInPlace, Unique:=True
.Columns(3).Offset(1).SpecialCells(xlCellTypeVisible).Copy
sh.Range("C1").PasteSpecial Paste:=xlPasteValues, Transpose:=True
Application.CutCopyMode = False
.Worksheet.ShowAllData
With .Resize(.Rows.Count - 1).Offset(1)
s = "=SUMPRODUCT((Sheet1!" & .Columns(1).Address & "&Sheet1!" _
& .Columns(3).Address & "=" & "$A2&C$1)*Sheet1!" & .Columns(4).Address & ")"
End With
With sh.Range("A1").CurrentRegion
With .Resize(.Rows.Count - 1, .Columns.Count - 2).Offset(1, 2)
.Formula = s
.Value = .Value
s = .Rows(1).Address(0, 1)
With .Resize(, 1).Offset(, .Columns.Count)
.Formula = "=SUM(" & s & ")"
.Value = .Value
.Offset(-1).Resize(1).Value = "不良合計"
End With
End With
End With
End With
Set sh = Nothing
End Sub
[#41860]のシートレイアウトでテスト。ただしSheet2はA1起点。
解説は苦手なのでまずは[ローカルウィンドウ]+[ステップ実行]が理解への近道かと。
#ADO+SQLはテストしてないのでレスできません。
|
|
Ned
- 06/8/26(土) 10:56 -
