ティーダ２

休日出勤しながら自分のソース、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文を実行する