Go to Qiita Advent Calendar 2024 Top
LoginSignup
0
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

More than 1 year has passed since last update.

@FK_0324(HGFF FFFFDX)

ティーダ２

Last updated at Posted at 2022-06-26

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

0
0
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
Sign upLogin
0
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?