| |
▼Ned さん：
>▼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さんはこういうコードをわずかな時間で書けるのでしょうか。
うらやしい どんな勉強法ですか？？？
★いい勉強方法があれば教えて下さい。
とにかく思っていたことは全て解決しました。
ありがとうございました。_(._.)_(^o^)
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
- 06/8/24(木) 16:34 -
