Sub start()
Dim strPath, strPath1, strLocalPath, strLocalBook As String
Dim strBook, strBook1 As String
Dim strGyou, strGyou1 As String
Dim strReso, strReso1 As String
Dim strSheet(20) As String
Dim strKikan, strKikan1 As String
Dim strOS, strChartMkbn, strChartClm As String
Dim dblClm, dblClm1 As String
Dim dblRow, dblRow1 As String
Dim dblsetData(1441) As String
Dim intRow As Integer
Dim strObjName As String
Dim strObj As Integer
Dim i As Integer
Dim result_copy As String
Dim output_csv_filename As String
Dim output_start_row2 As Integer
'# 変数セット start
' ★エラーになるので一時 out しておぐ
'With Application.FileDialog(msoFileDialogFolderPicker)
'.Title = "日次リソースフォルダを選んでね"
'.InitialFileName = "Sheet1.Cells(15,3)"
'If .Show = True Then
'strPath = .SelectedItem(1)
'End If
'End With
strLocalPath = ActiveWorkbook.Path
strLocalBook = ActiveWorkbook.Name
strGyou = Sheet1.Cells(2, 3)
strReso = Sheet1.Cells(3, 3)
strOS = Sheet1.Cells(10, 3)
strChartMkbn = Sheet1.Cells(11, 3)
strChartClm = Sheet1.Cells(13, 3)
If Sheet1.Cells(12, 3) = "折れ線" Then varChartType = 4
If Sheet1.Cells(12, 3) = "" Then varChartType = 65
If Sheet1.Cells(12, 3) = "" Then varChartType = 76
intRow = 25
'# 作業用シート
a = 3
Do Until Sheet1.Cells(4, a) = ""
' ★シートつぐっちゃうので 一時 out しておぐ
strSheet(a) = Sheet1.Cells(4, a)
'
' Sheets.Add After:=Sheets(Sheets.Count)
' ActiveSheet.Name = strSheet(a)
'# output file あるなら delete
If Dir(strLocalPath & "¥" & strSheet(a) & "_tmp.txt") <> "" Then
Kill strLocalPath & "¥" & strSheet(a) & "_tmp.txt"
End If
' MsgBox "a [" & a & "] strSheet(a)[" & strSheet(a) & "]"
a = a + 1
Loop
dblClm = Sheet1.Cells(7, 3) '#
dblClm1 = Sheet1.Cells(8, 3) '#
'# 変数セット end
'#===========================================
'# main start
'#===========================================
'# a は 日がはいる 20130329 20130330 20130331
For a = Sheet1.Cells(5, 3) To Sheet1.Cells(5, 4)
strBook = strGyou & strReso & "_" & a & ".xls"
strPath1 = "D:¥ファイル¥vba_macro¥" & strBook
If Dir(strPath1) <> "" Then
'MsgBox "1 strPath1 ファイルある " & strPath1
Workbooks.Open Filename:=strPath1
Else
' MsgBox "2 strPath1 ファイルない " & strPath1
GoTo LABEL1
End If
b = 3
'#プロパティで指定した シート分 loop strSheet(b)の値は、b★ct010 b★ct020 b★ct030
Do Until strSheet(b) = ""
' MsgBox "0004 次のシートへ移動 a [" & a & "] b [" & b & "] strSheet(b)[" & strSheet(b) & "]"
output_csv_filename = ActiveWorkbook.Path & "¥" & strSheet(b) & "_tmp.txt"
'# openしたファイルが 初日の場合
' If a = Sheet1.Cells(5, 3) Then
'範囲指定 一度にcopy
dblRow2 = Sheets(strSheet(b)).Cells(2, 20).End(xlDown).Row
input_start_row = 1
output_sheet_name = "sheet2"
sabun = dblRow2 - input_start_row
'初日の場合はタイトル必要なので1行よりcopy。2日以降は、タイトルいらないので2行目より copy
If a = Sheet1.Cells(5, 3) Then
start_row = 1
output_row_max = intRow
Else
start_row = 2
' MsgBox "1000c b[" & b & "] ThisWorkbook[" & ThisWorkbook.Name & "] ThisWorkbook.Sheets.Count[" & ThisWorkbook.Sheets.Count & "]" '# 5
' MsgBox "1000e ThisWorkbook.Sheets(strSheet(b))[" & ThisWorkbook.Sheets(strSheet(b)).Name & "]" '# エラープロシージャーでる
output_row_max = ThisWorkbook.Sheets(strSheet(b)).Range("T" & intRow).End(xlDown).Row + 1 '# copy先の最大行番号 T列が時間
End If
Call line_copy(strBook, strSheet(b), start_row, dblRow2, ThisWorkbook.Name, strSheet(b), output_row_max, output_row_max + sabun, a, intRow)
'# Clm サイド loop
dblRow1 = Sheets(strSheet(b)).Cells(2, dblClm).End(xlDown).Row '# dblClm は時間
'For d = dblClm To dblClm1
'Sheets(strSheet(b)).Cells(2, d).Select
'dblRow1 = Sheets(strSheet(b)).Cells(2, d).End(xlDown).Row
'Set UsedCell = Sheets(strSheet(b)).UsedRange
'Max_Row = UsedCell.Cells(UsedCell.Count).Row
'Max_Column = UsedCell.Cells(UsedCell.Count).Column
'# 時間のClm の最終行の値を採用する(抜げがないとして)
'If d = dblClm Then
' time_last_row = dblRow1
'End If
' c = 1
'Next
'# 日 整える
Sheets(strSheet(b)).Row (20)
'#/整える
b = b + 1
Loop
LABEL1:
Next
MsgBox "main end"
'# /main end
'# グラフ
Do Until strSheet(b) = ""
Sheets(strSheet(b)).Selection.AutoFilter
LABEL2:
b = b + 1
Loop
'# /グラフ
End Sub
'#===========================================
'# 行copy
'#===========================================
Function line_copy(input_file_name, input_sheet_name, input_start_row, input_end_row, _
output_file_name, output_sheet_name, output_start_row, output_end_row, _
resource_date, intRow)
Workbooks(output_file_name).Sheets(output_sheet_name).Rows(output_start_row & ":" & output_end_row).Value = _
Workbooks(input_file_name).Sheets(input_sheet_name).Rows(input_start_row & ":" & input_end_row).Value
' 初日
If intRow = output_start_row Then
output_start_row2 = output_start_row + 1
output_end_row2 = output_end_row
Else
'2日より後
output_start_row2 = output_start_row
output_end_row2 = output_end_row - 1
End If
MsgBox resource_date
'左に日にち入れる
Workbooks(output_file_name).Sheets(output_sheet_name).Range(Cells(output_start_row2, 19), Cells(output_end_row2, 19)).Value = resource_date
End Function