219 lines
7.7 KiB
QBasic
219 lines
7.7 KiB
QBasic
|
||
'******************************************************************************
|
||
'シート名
|
||
|
||
|
||
'共通変数
|
||
Public targetId As String
|
||
Public apiKey As String
|
||
Public baseURL As String
|
||
|
||
Function init()
|
||
'パブリック変数に値を格納
|
||
'事業計画テーブル 214737
|
||
targetId = Range("targetId")
|
||
|
||
'Pleasanter API KEY
|
||
apiKey = "6504c8a807677a3a576e10327f3c19876c55736ee45d4a845796b9e7f5e087bfd4bd0d8184863da8cf1733ca635111432ab334aea59102b06a96ee6d2c05190d"
|
||
baseURL = "https://nextoffice.Next-hd.co.jp"
|
||
|
||
End Function
|
||
|
||
Function exportDataToSheet(res, tableId, offset)
|
||
Debug.Print "出力開始"
|
||
Dim Sh As Worksheet
|
||
Set Sh = Worksheets(tableId & "")
|
||
|
||
'初回のみシートをクリア
|
||
If offset = 0 Then
|
||
Sh.Cells.Clear
|
||
End If
|
||
|
||
Dim lastRow As Long
|
||
lastRow = Sh.Cells(Rows.count, 1).End(xlUp).row
|
||
|
||
Dim data As New Dictionary
|
||
Dim dataCount As Long
|
||
dataCount = res("Response")("Data").count
|
||
|
||
Dim i, j As Long
|
||
' 2次元配列の宣言例（最大1000行×100列と仮定）
|
||
Dim arrData(1 To 1000, 1 To 100) As Variant
|
||
|
||
For i = 1 To dataCount
|
||
'店舗名取得
|
||
Dim shopName As String
|
||
shopName = res("Response")("Data")(i)("ClassHash")("ClassB")
|
||
shopName = Replace(shopName, "/", "")
|
||
|
||
Dim shopFlag
|
||
shopFlag = res("Response")("Data")(i)("CheckHash")("CheckA")
|
||
|
||
'Dataシート存在確認
|
||
Dim shExist1, shExist2
|
||
|
||
shExist1 = SheetExists(shopName & "_DATA")
|
||
If shExist1 = False Then
|
||
Worksheets("DATAテンプレート").Copy After:=Worksheets(Worksheets.count)
|
||
ActiveSheet.Name = shopName & "_DATA"
|
||
ActiveSheet.Visible = False
|
||
End If
|
||
shExist1 = SheetExists(shopName & "_DATA")
|
||
|
||
shExist2 = SheetExists(shopName & "_受着完")
|
||
If shExist2 = False Then
|
||
If shopFlag = True Then
|
||
Worksheets("受着完テンプレート2").Copy Before:=Worksheets(shopName & "_DATA")
|
||
Else
|
||
Worksheets("受着完テンプレート1").Copy Before:=Worksheets(shopName & "_DATA")
|
||
End If
|
||
|
||
ActiveSheet.Name = shopName & "_受着完"
|
||
ActiveSheet.Range("A1") = shopName
|
||
ActiveSheet.Range("A3") = shopFlag
|
||
End If
|
||
|
||
shExist2 = SheetExists(shopName & "_損益")
|
||
|
||
If shExist2 = False Then
|
||
Worksheets("損益テンプレート").Copy After:=Worksheets(shopName & "_受着完")
|
||
ActiveSheet.Name = shopName & "_損益"
|
||
ActiveSheet.Range("A1") = shopName
|
||
ActiveSheet.Range("A3") = shopFlag
|
||
End If
|
||
|
||
'Dictionaryへの格納
|
||
data.Add "ResultId", res("Response")("Data")(i)("ResultId")
|
||
data.Add "Status", res("Response")("Data")(i)("Status")
|
||
data.Add "ItemTitle", res("Response")("Data")(i)("ItemTitle")
|
||
data.Add "Updator", res("Response")("Data")(i)("Updator")
|
||
data.Add "UpdatedTime", stringToDate(res("Response")("Data")(i)("UpdatedTime"))
|
||
data.Add "Body", res("Response")("Data")(i)("Body")
|
||
|
||
' 2次元配列への格納
|
||
For j = 1 To 100
|
||
arrData(i, j) = "" ' 初期化
|
||
Next j
|
||
arrData(i, 1) = res("Response")("Data")(i)("ResultId")
|
||
arrData(i, 2) = res("Response")("Data")(i)("Status")
|
||
arrData(i, 3) = res("Response")("Data")(i)("ItemTitle")
|
||
arrData(i, 4) = res("Response")("Data")(i)("Updator")
|
||
arrData(i, 5) = stringToDate(res("Response")("Data")(i)("UpdatedTime"))
|
||
arrData(i, 6) = res("Response")("Data")(i)("Body")
|
||
|
||
Dim keys, items, count
|
||
|
||
'Class
|
||
keys = res("Response")("Data")(i)("ClassHash").keys
|
||
items = res("Response")("Data")(i)("ClassHash").items
|
||
count = res("Response")("Data")(i)("ClassHash").count
|
||
For j = 0 To count - 1
|
||
data.Add keys(j), Replace(items(j), "/", "")
|
||
arrData(i, 6 + j + 1) = Replace(items(j), "/", "")
|
||
Next j
|
||
'Num
|
||
keys = res("Response")("Data")(i)("NumHash").keys
|
||
items = res("Response")("Data")(i)("NumHash").items
|
||
count = res("Response")("Data")(i)("NumHash").count
|
||
For j = 0 To count - 1
|
||
data.Add keys(j), items(j)
|
||
arrData(i, 6 + count + j + 1) = items(j)
|
||
Next j
|
||
'Date
|
||
keys = res("Response")("Data")(i)("DateHash").keys
|
||
items = res("Response")("Data")(i)("DateHash").items
|
||
count = res("Response")("Data")(i)("DateHash").count
|
||
For j = 0 To count - 1
|
||
data.Add keys(j), stringToDate(items(j))
|
||
arrData(i, 6 + count * 2 + j + 1) = stringToDate(items(j))
|
||
Next j
|
||
|
||
'Description
|
||
'keys = res("Response")("Data")(i)("DescriptionHash").keys
|
||
'items = res("Response")("Data")(i)("DescriptionHash").items
|
||
'count = res("Response")("Data")(i)("DescriptionHash").count
|
||
'For j = 0 To count - 1
|
||
' data.Add keys(j), items(j)
|
||
'Next j
|
||
|
||
If shExist1 Then
|
||
Debug.Print shopName
|
||
Dim g
|
||
g = 3
|
||
Dim id1, id2, id3, id4, id5, id6
|
||
For j = 1 To 12
|
||
id1 = "Description" & Format(j, "000") '受注-計画 4
|
||
id2 = "Description" & Format(j + 60, "000") '着工-計画 26
|
||
id3 = "Description" & Format(j + 120, "000") '完成-計画 48
|
||
|
||
id4 = "Description" & Format(j + 20, "000") '受注-実績 15
|
||
id5 = "Description" & Format(j + 80, "000") '着工-実績 37
|
||
id6 = "Description" & Format(j + 140, "000") '完成-実績 59
|
||
|
||
|
||
'Call exportJsonToSheet(res("Response")("Data")(i)("DescriptionHash")(id1), g, 4, shopName & "_DATA")
|
||
'Call exportJsonToSheet(res("Response")("Data")(i)("DescriptionHash")(id2), g, 26, shopName & "_DATA")
|
||
'Call exportJsonToSheet(res("Response")("Data")(i)("DescriptionHash")(id3), g, 48, shopName & "_DATA")
|
||
'Call exportJsonToSheet(res("Response")("Data")(i)("DescriptionHash")(id4), g, 15, shopName & "_DATA")
|
||
'Call exportJsonToSheet(res("Response")("Data")(i)("DescriptionHash")(id5), g, 37, shopName & "_DATA")
|
||
'Call exportJsonToSheet(res("Response")("Data")(i)("DescriptionHash")(id6), g, 59, shopName & "_DATA")
|
||
|
||
g = g + 7
|
||
Next j
|
||
|
||
End If
|
||
|
||
'Check
|
||
keys = res("Response")("Data")(i)("CheckHash").keys
|
||
items = res("Response")("Data")(i)("CheckHash").items
|
||
count = res("Response")("Data")(i)("CheckHash").count
|
||
For j = 0 To count - 1
|
||
data.Add keys(j), items(j)
|
||
arrData(i, 6 + count * 3 + j + 1) = items(j)
|
||
Next j
|
||
|
||
|
||
Dim k, itemCount As Long
|
||
itemCount = data.count
|
||
For k = 1 To itemCount
|
||
If (i + lastRow - 1) = 1 Then
|
||
'Sh.Cells((i + lastRow - 1), k) = data.keys(k - 1)
|
||
End If
|
||
|
||
'Sh.Cells((i + lastRow), k) = data.items(k - 1)
|
||
Next k
|
||
|
||
data.RemoveAll
|
||
|
||
Next i
|
||
|
||
' 配列の内容を一括でシートに書き込み
|
||
Sh.Range(Sh.Cells(lastRow + 1, 1), Sh.Cells(lastRow + dataCount, 100)).Value = arrData
|
||
|
||
Debug.Print "出力完了"
|
||
End Function
|
||
|
||
Function exportJsonToSheet(dataStr, col, row, shName)
|
||
|
||
Dim Sh As Worksheet
|
||
Set Sh = Worksheets(shName)
|
||
Sh.Range(Sh.Cells(row, col), Sh.Cells(row + 9, col + 5)).ClearContents
|
||
|
||
If dataStr <> "" Then
|
||
Dim dataObj As Object
|
||
Set dataObj = JsonConverter.ParseJson(dataStr)
|
||
|
||
Dim var, i
|
||
i = 0
|
||
For Each var In dataObj
|
||
Sh.Cells(row + i, col) = stringToDate(var("1"))
|
||
Sh.Cells(row + i, col + 1) = var("2")
|
||
Sh.Cells(row + i, col + 2) = var("3")
|
||
Sh.Cells(row + i, col + 3) = var("4")
|
||
Sh.Cells(row + i, col + 4) = var("6")
|
||
Sh.Cells(row + i, col + 5) = var("7")
|
||
i = i + 1
|
||
Next var
|
||
End If
|
||
|
||
End Function |