vba2

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 & &yen; & strSheet(a) & _tmp.txt ) <> Then
Kill strLocalPath & &yen; & 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:&yen;ファイル&yen;vba_macro&yen; & 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 & &yen; & 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