複数シート、計算範囲が可変でのピボットテーブルマクロ
初めてのマクロで困っています。
エラーメッセージは、
実行時エラー '13':
型が一致しません。
＝＝＝で囲んだ部分がデバックをクリックすると黄色で表示されます。
すみませんが、どなたかご指摘お願いします。
どうぞよろしくお願いいたします。
Sub test()
Dim i As Integer
Dim SET_SheetCnt As Integer
Dim SET_SheetName As String
Dim SET_SheetN_C As String
Dim SET_startRow As Long
Dim SET_endRow As Long
Dim SET_startCell As String
Dim SET_endCell As String
Dim SET_Cell As String
Dim SET_Returnsheet As String
Dim DQ As String
Dim SET_FileNo As Integer
SET_SheetCnt = ThisWorkbook.Sheets.Count
SET_Returnsheet = ActiveSheet.Name
SET_FileNo = FreeFile
DQ = Chr$(&H22)
Sheets(SET_Returnsheet).Cells.Clear
For i = 1 To SET_SheetCnt
SET_SheetName = Worksheets(i).Name
If SET_SheetName <> SET_Returnsheet And SET_SheetName <> "template" Then
With ThisWorkbook.Worksheets(i)
'Start行
Cells(2, 2).Select
SET_startRow = .Cells.Find(What:="業務名", After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, MatchByte:=False).Row
SET_startCell = "R" & SET_startRow & "C3"
'End行
SET_endRow = .Cells(.Rows.Count, 19).End(xlUp).Row
SET_endCell = "R" & SET_endRow & "C19"
SET_Cell = SET_startCell & ":" & SET_endCell
'計算範囲の書き込み
Worksheets(SET_Returnsheet).Cells(1, 1).Value = "計算範囲"
Worksheets(SET_Returnsheet).Cells(Rows.Count, 1).End(xlUp).Offset(1).Value = "Array(" & DQ & "'" & SET_SheetName & "'!" & SET_Cell & DQ & ", " & DQ & SET_SheetName & DQ & "), "
End With
End If
Next i
'最終セルの不要な文字列を取りファイルに格納
Sheets(SET_Returnsheet).Select
Dim LastRow As Integer
With Worksheets(SET_Returnsheet).Cells.SpecialCells(xlCellTypeConstants).Areas
With .Item(.Count)
LastRow = .Item(.Count).Row
End With
End With
Dim a As String
Dim b As String
Dim c As String
Dim d As String
a = Worksheets(SET_Returnsheet).Cells(LastRow, 1).Value
b = Len(a)
c = Mid(a, 1, (b - 2))
Worksheets(SET_Returnsheet).Cells(LastRow, 1).Value = c
Open "c:\test.txt" For Output As #SET_FileNo
For i = 2 To LastRow
d = Worksheets(SET_Returnsheet).Cells(i, 1).Value
Print #SET_FileNo, d;
Next i
Close #SET_FileNo
Dim FileData As variant
Open "c:\test.txt" For Input As #SET_FileNo
While Not EOF(SET_FileNo)
Line Input #SET_FileNo, FileData
Debug.Print FileData
Wend
Close #SET_FileNo
'ピボット計算-------
Worksheets(SET_Returnsheet).Activate
Sheets(SET_Returnsheet).Cells.Clear
'==ここから黄色で囲まれる分です====
ThisWorkbook.PivotCaches.Add(SourceType:=xlConsolidation, SourceData:= _
Array(FileData)).CreatePivotTable TableDestination _
:=Range("A11"), TableName:="ピボットテーブル1"
'===ここまで====
ActiveSheet.PivotTables("ピボットテーブル1").SmallGrid = False
ActiveSheet.PivotTables("ピボットテーブル1").PivotFields("データ").PivotItems( _
"データの個数 : 値").Position = 1
Range("A17").Select
ActiveWindow.SmallScroll Down:=-9
ActiveSheet.PivotTables("ピボットテーブル1").PivotSelect "行[すべて]", xlLabelOnly
Range("A11").Select
ActiveSheet.PivotTables("ピボットテーブル1").PivotFields("データの個数 : 値").Function = _
xlSum
End Sub
お礼
お礼が遅くなってしまいましたが、ご回答どうもありがとうございます!