休日出勤しながら自分のソース、quitaに保存するの気持ち良すぎだろ
Option Explicit
'定数
Const extension As String = "xls"
Const extension2 As String = "xlsm"
Const writeMessage As String = "変更はありませんでした"
Const succesedMessage As String = "正常に処理が完了しました"
Const errorMessage_ws As String = "帳票出力仕様のワークシートが存在しません"
Const errorMessage_fd As String = "ファイルダイアログがキャンセルされました"
Const targetWS As String = "帳票定義属性"
Sub ボタン1_Click()
'ファイルシステムオブジェクト関連
Dim fso As FileSystemObject
Dim file As Scripting.file
Dim fd As FileDialog
Dim fol As Object
Dim folderPath As String
Dim filePath() As String
Dim name As Object
'ワークブック
Dim wb As Workbook
'ワークシート
Dim intRow As Integer
'ドキュメントの属性
Dim writeCount As Long
'デバッグ関連
Dim i As Long
Dim j As Long
Dim k As Long
Dim nullCount As Long
Dim N As Long
Dim sw As Boolean
Set fso = New Scripting.FileSystemObject
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
If Not fd.Show Then
MsgBox errorMessage_fd, vbExclamation
Exit Sub
End If
folderPath = fd.SelectedItems(1)
writeCount = 0
'親フォルダーのファイル探索
For Each file In fso.GetFolder(folderPath).files
If fso.GetExtensionName(file.path) = extension Or _
fso.GetExtensionName(file.path) = extension2 Then: _
Call addToArray(filePath, file.path)
Next file
'サブフォルダーの再帰呼び出し
Call getAllFiles(folderPath, fso, filePath)
N = UBound(filePath)
' 添削処理
Application.DisplayAlerts = False
If isArrayEx(filePath) = 1 Then
For i = 0 To N
Set fso = Nothing
sw = False
Set wb = Workbooks.Open(filePath(i))
For Each name In wb.Names
If InStr(name, "\\") <> 0 Or InStr(name, "W:\") <> 0 _
Or InStr(name, "C:\") <> 0 Or InStr(name, "#REF!") <> 0 Then
'name.Delete
sw = True
End If
Next name
wb.Save
wb.Close
If sw Then
Debug.Print fso.GetFileName(filePath(i))
Else
fso.GetFile(filePath(i)).Delete
End If
Next i
End If
Application.DisplayAlerts = True
If writeCount > 0 Then
MsgBox succesedMessage & vbCrLf & _
"書込み件数" & writeCount, vbInformation
Else
MsgBox succesedMessage & vbCrLf & _
writeMessage, vbInformation
End If
End Sub
Sub addToArray(ByRef s() As String, ByVal v As String)
If isEmptyArray(s) Then
ReDim s(0)
s(0) = v
Else
ReDim Preserve s(UBound(s) + 1)
s(UBound(s)) = v
End If
End Sub
Sub getAllFiles(ByVal path As String, ByRef fso As FileSystemObject, ByRef filePath() As String)
Dim files As Object
Dim fol As Object
Dim folders As Object
Dim file As Object
Set folders = fso.GetFolder(path).SubFolders
If IsObject(folders) Then
For Each fol In folders
Set files = fso.GetFolder(fol).files
If IsObject(files) Then
For Each file In files
If fso.GetExtensionName(file.path) = "xls" Or _
fso.GetExtensionName(file.path) = "xlsm" Then: _
Call addToArray(filePath, file.path)
Next file
End If
'サブフォルダーがあれば繰り返し探索する
Call getAllFiles(fol, fso, filePath)
Set files = Nothing
Next fol
End If
End Sub
Function isEmptyArray(s() As String) As Boolean
If (Not s) = -1 Then
isEmptyArray = True
Else
isEmptyArray = (UBound(s) = 0 And s(0) = "")
End If
End Function
Function isArrayEx(varArray As Variant) As Long
On Error GoTo ERROR_
If IsArray(varArray) Then
isArrayEx = IIf(UBound(varArray) >= 0, 1, 0)
Else
isArrayEx = -1
End If
Exit Function
ERROR_:
If Err.Number = 9 Then
isArrayEx = 0
End If
End Function
データ分析（参考psql）
CREATE TABLE JZZ038C_W AS
select
M00.sakujoflag
, M00.gyomushubetsu
, M00.seirekinnd
, M00.szkcode
, M00.ktgbngto
, M00.uwkbngto
, M00.rembanto
, '' AS ktgbng3
, '' AS ktgbng4
-- 業務ＩＤ
, CASE
WHEN M00.gyomushubetsu = '31'
AND M01.snykbn <> '02' THEN 'JZC30101'
WHEN M00.gyomushubetsu = '31'
AND M02.chtiktgnnd IS NOT NULL THEN 'JZC30101'
WHEN M00.gyomushubetsu = '31'
AND M01.snykbn = '02' THEN 'JZC30201'
WHEN M00.gyomushubetsu = '40'
AND M04.skssu <= 1 THEN 'JZD40101'
WHEN M00.gyomushubetsu = '40'
AND M04.skssu > 1 THEN 'JZD40201'
WHEN M00.gyomushubetsu = '41'
AND M05.skssu <= 1 THEN 'JZD40301'
WHEN M00.gyomushubetsu = '41'
AND M05.skssu > 1 THEN 'JZD40401'
WHEN M00.gyomushubetsu = '42'
AND M08.sokusistkbn = 0
AND M08.skssu <= 1 THEN 'JZD40501'
WHEN M00.gyomushubetsu = '42'
AND M08.sokusistkbn = 0
AND M08.skssu > 1 THEN 'JZD40601'
WHEN M00.gyomushubetsu = '42'
AND M08.sokusistkbn = 1
AND M08.fkssnykbncode <> '08'
AND M08.skssu <= 1 THEN 'JZD40701'
WHEN M00.gyomushubetsu = '42'
AND M08.sokusistkbn = 1
AND M08.fkssnykbncode <> '08'
AND M08.skssu > 1 THEN 'JZD40801'
WHEN M00.gyomushubetsu = '42'
AND M08.sokusistkbn = 1
AND M08.fkssnykbncode = '08'
AND M08.skssu <= 1 THEN 'JZD40901'
ELSE '' END AS gyoumid
-- 予算種別コード
, CASE
WHEN M00.gyomushubetsu = '31'
AND M01.snykbn <> '02' THEN '1'
WHEN M00.gyomushubetsu = '31'
AND M01.snykbn IS NULL THEN '1'
WHEN M00.gyomushubetsu = '31'
AND M01.snykbn = '02' THEN M01.yosanshubetsucode
WHEN M00.gyomushubetsu = '40' THEN M04.yosanshubetsucode
WHEN M00.gyomushubetsu = '41' THEN M05.yosanshubetsucode
WHEN M00.gyomushubetsu = '42'
AND M09.yosanshubetsucode IS NOT NULL THEN M09.yosanshubetsucode
WHEN M00.gyomushubetsu = '42'
AND M09.yosanshubetsucode IS NULL THEN M04.yosanshubetsucode
ELSE '' END AS yosanshubetsucode
-- システム区分コード
, CASE
WHEN M00.gyomushubetsu = '31'
AND M01.snykbn <> '02' THEN 0
WHEN M00.gyomushubetsu = '31'
AND M01.snykbn IS NULL THEN 1
WHEN M00.gyomushubetsu = '31'
AND M01.snykbn = '02' THEN 0
WHEN M00.gyomushubetsu = '40' THEN cast( M04.systemkbncode as integer )
WHEN M00.gyomushubetsu = '41' THEN cast( M05.systemkbncode as integer )
WHEN M00.gyomushubetsu = '42' THEN cast( M08.systemkbncode as integer )
ELSE 0 END AS systemkbncode
-- 決議金額
, CASE
WHEN M00.gyomushubetsu = '41'
AND M11.sistftkzoggk_sum IS NOT NULL THEN M11.sistftkzoggk_sum
WHEN M00.gyomushubetsu = '41'
AND M11.sistftkzoggk_sum IS NULL THEN 0
ELSE M00.ktgkgk END AS ktgkgk
, M00.kessaijotai
-- 債権債務者名
, CASE
WHEN M00.gyomushubetsu = '31'
AND M01.snykbn <> '02' THEN cast(concat(M03.hjmto,M03.shimei) as text)
WHEN M00.gyomushubetsu = '31'
AND M01.snykbn IS NULL THEN cast(concat(M02.hjmto,M02.shimei) as text)
WHEN M00.gyomushubetsu = '31'
AND M01.snykbn = '02' THEN cast(concat(M03.hjmto,M03.shimei) as text)
WHEN M00.gyomushubetsu = '40' THEN cast(concat(M10.hjmto,M10.shimei) as text)
WHEN M00.gyomushubetsu = '41' THEN cast(concat(M10.hjmto,M10.shimei) as text)
WHEN M00.gyomushubetsu = '42'
AND M09.yosanshubetsucode IS NOT NULL THEN cast(concat(M09.hjmto,M09.shimei) as text)
WHEN M00.gyomushubetsu = '42'
AND M09.yosanshubetsucode IS NULL THEN cast(concat(M10.hjmto,M10.shimei) as text)
ELSE '' END AS saikensmsmei
-- 債権債務者数
, CASE
WHEN M00.gyomushubetsu = '31'
AND M01.snykbn <> '02' THEN M01.chtiuwkkensu
WHEN M00.gyomushubetsu = '31'
AND ( M02.shimei IS NOT NULL
OR M02.hjmto IS NOT NULL ) THEN 1
WHEN M00.gyomushubetsu = '31'
AND M01.snykbn = '02' THEN 1
WHEN M00.gyomushubetsu = '40' THEN cast( M04.skssu as integer )
WHEN M00.gyomushubetsu = '41' THEN cast( M05.skssu as integer )
WHEN M00.gyomushubetsu = '42' THEN cast( M08.skssu as integer )
ELSE 0 END AS saikensmssu
--決議年度
, CASE
WHEN M00.gyomushubetsu = '31'
AND M01.snykbn <> '02' THEN M01.chtiymd
WHEN M00.gyomushubetsu = '31'
AND M01.snykbn IS NULL THEN M02.chtiymd
WHEN M00.gyomushubetsu = '31'
AND M01.snykbn = '02' THEN M01.chtiymd
WHEN M00.gyomushubetsu = '40' THEN M04.sistftkymd
WHEN M00.gyomushubetsu = '41' THEN M07.henkoymd
WHEN M00.gyomushubetsu = '42' THEN M08.sistmriymd
ELSE NULL END AS ktgymd
, M00.renkeikaishibi
, M00.renkeiymd
, M00.shryoteiymd
-- 支払年月日
, CASE
WHEN M00.gyomushubetsu = '42' THEN M08.shrymd
ELSE NULL END AS shrymd
-- 支払確認済フラグ
, CASE
WHEN M00.gyomushubetsu = '42'
AND M08.shrymd IS NOT NULL THEN '1'
WHEN M00.gyomushubetsu = '42'
AND M08.shrymd IS NULL THEN '0'
ELSE NULL END AS shrkakuninzumiflag
-- 備考
, CASE
WHEN M00.gyomushubetsu = '31'
AND M01.snykbn <> '02' THEN M03.nofuriyu
WHEN M00.gyomushubetsu = '31'
AND M01.snykbn IS NULL THEN M02.nofuriyu
WHEN M00.gyomushubetsu = '31'
AND M01.snykbn = '02' THEN M03.nofuriyu
WHEN M00.gyomushubetsu = '40' THEN M04.shrnaiyo
WHEN M00.gyomushubetsu = '41' THEN M05.shrnaiyo
WHEN M00.gyomushubetsu = '42' THEN M08.shrnaiyo
ELSE NULL END AS biko
, '' AS renkeikomoku1
, '' AS renkeikomoku2
, '' AS renkeikomoku3
, '' AS renkeikomoku4
, '' AS renkeikomoku5
, M00.torokukoyubng
, M00.torokujikoku
, M00.saishushuseikoyubng
, M00.saishushuseijikoku
, M00.versionno
from
jzz038c AS M00
left join jzc301c AS M01
ON M00.seirekinnd = M01.seirekinnd
-- AND cast(right(M00.ktgbngto,5) as integer) = M01.chtiktgbng
AND M00.ktgbngto = right(cast(M01.chtiktgnnd as text) ,2) || lpad(cast(M01.chtiktgbng as text),5,'0')
AND M00.szkcode = M01.szkcode
AND M00.ktgkgk = M01.chtikgkgki
AND M00.gyomushubetsu='31'
-- AND ( SELECT count() FROM JZC301C C WHERE C.szkcode = M00.szkcode and C.seirekinnd = M00.seirekinnd and M00.ktgkgk = C.chtikgkgki and M00.ktgbngto = right(cast(C.chtiktgnnd as text) ,2) || lpad(cast(C.chtiktgbng as text),5,'0') GROUP BY C.seirekinnd,C.szkcode,C.chtiktgbng,C.chtiktgnnd,C.chtikgkgki ) = 1
left join jzc304c AS M02
ON M00.seirekinnd = M02.seirekinnd
-- AND cast(right(M00.ktgbngto,5) as integer) = M02.chtiktgbng
AND M00.ktgbngto = right(cast(M02.chtiktgnnd as text) ,2) || lpad(cast(M02.chtiktgbng as text),5,'0')
AND M00.szkcode = M02.szkcode
AND M00.ktgkgk = M02.chtikgkgki
AND M00.gyomushubetsu='31'
-- AND ( SELECT count() FROM JZC304C C WHERE C.szkcode = M00.szkcode and C.seirekinnd = M00.seirekinnd and M00.ktgkgk = C.chtikgkgki and M00.ktgbngto = right(cast(C.chtiktgnnd as text) ,2) || lpad(cast(C.chtiktgbng as text),5,'0') GROUP BY C.seirekinnd,C.szkcode,C.chtiktgbng,C.chtiktgnnd,C.chtikgkgki ) = 1
left join jzc324c AS M03
ON M01.seirekinnd = M03.seirekinnd
AND M01.szkcode = M03.szkcode
AND right(cast(M01.chtiktgnnd as text) ,2) || lpad(cast(M01.chtiktgbng as text),5,'0') = right(cast(M03.chtiktgnnd as text) ,2) || lpad(cast(M03.chtiktgbng as text),5,'0')
AND M01.chtiuwkkensu <> 0
AND M03.chtiuwkbng = 1
-- AND M01.chtikgkgki = M03.chtikgk
left join jzd401c AS M04
ON ( M00.seirekinnd = M04.seirekinnd
AND cast(right(M00.ktgbngto,5) as integer) = M04.sistftkbng
AND M00.szkcode = M04.szkcode
AND M00.gyomushubetsu = '40' )
OR ( cast(left(M00.ktgbngto,5) as integer) = M04.sistftkbng
AND M00.seirekinnd = M04.seirekinnd
AND M00.szkcode = M04.szkcode
AND M00.gyomushubetsu = '42' )
left join jzd401c AS M05
ON M00.seirekinnd = M05.seirekinnd
AND cast(right(M00.ktgbngto,5) as integer) = M05.sistftkbng
AND M00.szkcode = M05.szkcode
AND M00.gyomushubetsu='41'
left join jzd402c AS M06
ON ( M04.seirekinnd = M06.seirekinnd
AND M04.sistftkbng= M06.sistftkbng
AND M04.szkcode = M06.szkcode
AND M06.sistftkuwkbng = 1 )
OR (M05.seirekinnd = M06.seirekinnd
AND M05.sistftkbng= M06.sistftkbng
AND M05.szkcode = M06.szkcode
AND M06.sistftkuwkbng = 1 )
left join jzd440c M07
ON M05.szkcode = M07.szkcode
AND M05.seirekinnd = M07.seirekinnd
AND M05.sistftkbng = M07.sistftkbng
AND cast(M00.rembanto as integer) = M07.sistftkhenkokaisu
AND M07.sistftkuwkbng=1
left join jzd404c M08
ON M00.szkcode = M08.szkcode
AND M00.seirekinnd = M08.seirekinnd
AND cast(left(M00.ktgbngto,5) as integer) = M08.sistftkbng
AND cast(right(M00.ktgbngto,2) as integer) = M08.sistmrikaisu
AND M00.gyomushubetsu='42'
left join jzd405c M09
ON M08.szkcode = M09.szkcode
AND M08.seirekinnd = M09.seirekinnd
AND M08.sistftkbng = M09.sistftkbng
AND M08.sistmrikaisu = M09.sistmrikaisu
AND M09.sistmriuwkbng = 1
left join jzz012m M10
ON M06.skscode = M10.saikensmscode
-- WHERE M03.nofuriyu is NULL and M00.gyomushubetsu = '31'
left join ( SELECT szkcode,seirekinnd,sistftkbng,henkokaisu,SUM(sistftkzoggk) AS sistftkzoggk_sum FROM jzd403c GROUP BY szkcode,seirekinnd,sistftkbng,henkokaisu) M11
ON M07.szkcode = M11.szkcode
AND M07.seirekinnd = M11.seirekinnd
AND M07.sistftkbng = M11.sistftkbng
AND M07.sistftkhenkokaisu = M11.henkokaisu
ORDER BY M00.saishushuseijikoku desc
-- JZZ038C CREATE TABLE文を実行する