| |
こんにちは。かみちゃん です。
> シート1（List1)に累計値がないとフィルターでは無理でしょうか？
>シート1のデータは３店舗×3項目で１日９行が１年分あります
>係りは30係あります
方法はいろいろあると思いますが、私なら、SQLを使って累計値を計算します。
ただ、初心者や、AccessやSQLをご存知でない場合は、少々難しいかもしれません。
こんなこともできるのね、という程度で参考にしていただければと思います。
こちらでは、サンプルデータで動作確認できています。
（ただし、3係分でテストしました。）
Sub Sample1()
Dim cn As Object
Dim link_opt As String
Dim idx As Long
Dim rs As Object
Dim mysql As String
Dim WS1 As Worksheet
Dim WS2 As Worksheet
Dim rng1 As Range
Set WS1 = Sheets("Sheet1")
Set WS2 = Sheets("Sheet2")
Set rng1 = WS1.Range("A1").CurrentRegion
'Excelデータベースに接続
link_opt = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & ThisWorkbook.FullName & ";" & _
"Extended Properties=Excel 8.0;"
On Error Resume Next
Set cn = CreateObject("ADODB.Connection")
cn.Open link_opt
On Error GoTo 0
'接続ＯＫの場合
If Not cn Is Nothing And Err.Number = 0 Then
mysql = "SELECT 日付 AS 抽出, 店舗, 項目, [1係], [2係], [3係] " & _
"FROM [" & WS1.Name & "$" & rng1.Address(0, 0) & "] " & _
"WHERE 日付=""20070402"" AND 店舗=""本店"" "
mysql = mysql & " " & "UNION ALL "
mysql = mysql & "SELECT ""累計"" AS 抽出, 店舗, 項目, Sum([1係]) AS 1係, Sum([2係]) AS 2係, Sum([3係]) AS 3係 " & _
"FROM [" & WS1.Name & "$" & rng1.Address(0, 0) & "] " & _
"WHERE 日付<=""20070402"" " & _
"GROUP BY ""累計"", 店舗, 項目 " & _
"HAVING 店舗=""本店"" "
'データベースを開く
On Error Resume Next
Set rs = cn.Execute(mysql)
On Error GoTo 0
'データ取得
If Not rs Is Nothing And Err.Number = 0 Then
With WS2
.Cells.ClearContents
For idx = 0 To rs.fields.Count - 1
.Cells(1, idx + 1).Value = rs.fields(idx).Name
Next
.Range("A2").CopyFromRecordset rs
.Range("A1").CurrentRegion.Sort Key1:=Range("A2"), Order1:=xlAscending, _
Key2:=Range("C2"), Order2:=xlDescending, Header:=xlGuess
End With
Else
MsgBox "レコードセットを開けません"
End If
'データベースを閉じる
On Error Resume Next
rs.Close
Set rs = Nothing
On Error GoTo 0
'接続を切断する
On Error Resume Next
cn.Close
Set cn = Nothing
On Error GoTo 0
Else
MsgBox "データベースに接続できません"
End If
End Sub
|
|
かみちゃん
- 07/5/4(金) 18:38 -
