監造日報表系列-進度湊不到100%的解法

監造日報表在填寫數量的時候有兩種方法

1.單一工項

2.組合工項

經使用者反應，常因為數量計算表或數量統計表上的四捨五入問題，最後可能會有實際進度無法變成100%的狀況產生。

在組合工項的處理上，藉由設計圖上的標示尺寸來設置單元數量(U型溝每進行米共需多少鋼筋、模板、混凝土or紐澤西護欄每塊共需多少鋼筋、模板、混凝土、油漆)，除了便於監造人員便於計算工程用量，也能透過單元的總計檢討先進行初步檢核總量是否有異常，計算所得到的單元數量才一併列於數量統計表上，最後所有數量列出後的加總值才進行四捨五入，自然而然會有些許的誤差導致無法於實際進度表上看見100%的數值。

接下來會將這個模組放置於新版本中，有興趣請加入我的官方賴，會在更新時一併提醒訂閱用戶哦~

--------------------------------------------------------------------------

解決方法

將所有的項目都列出後，數量都已確認放上去，再將契約數量與實際數量的誤差攤回去原本的工程用量做尾數補整即可。

程式碼如下

'------20221122 處理剩餘零星數量--------

Sub getOverNumberFromLastDay()

reportNum = InputBox("請輸入理應為100%的報表編號")
allowence = InputBox("請輸入校正回歸允許值", , 1)
prompt = "***校正回歸完成項目***" & vbNewLine

With Sheets("Report")

    .Range("K2") = reportNum

    Call ReportRun
    
    For r = 8 To getReportLastRow
    
        conNum = .Cells(r, "F")
        sumNum = .Cells(r, "I")
        
        If conNum <> sumNum Then
        
            itemName = .Cells(r, "B")
            numDiff = Round(sumNum - conNum, 4)
            
            If Abs(numDiff) < allowence Then
            
                Call dealOverNum(itemName, numDiff)
            
                prompt = prompt & vbNewLine & itemName & ":" & numDiff
        
            End If
        
        End If
    
    Next
    
    MsgBox prompt, vbInformation

End With

End Sub

Sub dealOverNum(ByVal itemName As String, ByVal numDiff As Double)

With Sheets("Records")

    lr = .Cells(.Rows.count, 1).End(xlUp).Row
    
    For r = lr To 3 Step -1
    
        recName = .Cells(r, "E")
        
        If recName = itemName Then
        
            originNum = .Cells(r, "F")
            
            adjustNum = originNum - numDiff
            
            If adjustNum > 0 Then
            
                Debug.Print itemName & ",原數量=" & originNum & ">>校正=" & adjustNum
            
                .Cells(r, "F").AddComment "originNum=" & .Cells(r, "F") & ">>adjustNum=" & adjustNum
            
                .Cells(r, "F") = adjustNum
                .Cells(r, "F").Font.ColorIndex = 7
                
                Exit For
            
            End If
        
        End If
        
    Next

End With

End Sub