- 帖子
- 2834
- 主題
- 10
- 精華
- 0
- 積分
- 2890
- 點名
- 0
- 作業系統
- 〔略〕
- 軟體版本
- 〔略〕
- 閱讀權限
- 100
- 性別
- 男
- 來自
- 〔略〕
- 註冊時間
- 2013-5-13
- 最後登錄
- 2024-11-27
|
3#
發表於 2015-9-24 11:39
| 只看該作者
本帖最後由 准提部林 於 2015-9-24 11:45 編輯
在〔輸入表〕輸入完成後，再派出結果至〔報表〕，
做了幾個防呆，參考看看：- Sub 派出結果()
- Dim Arr, A, T$, xD, DT As Range
- Set DT = [H22]
- Set xD = CreateObject("Scripting.Dictionary")
- Arr = Range([Database!B2], [Database!B65536].End(xlUp)(2))
- For Each A In Arr
- T = Right(A, 7): If T Like "#######" Then xD(T) = 1
- Next
- If xD.Count = 0 Then MsgBox "Database無資料可作業！": Exit Sub
-
- Dim FL$, xB As Workbook, xS As Worksheet, R&
- FL = ThisWorkbook.Path & "\範例報表.xls"
- If Dir(FL) = "" Then MsgBox "找不到報表檔！": Exit Sub
- If CheckBookOpen(FL) > 0 Then
- MsgBox "報表檔正被開啟中，為避免錯誤，請先關閉！": Exit Sub
- End If
-
- Set xB = Workbooks.Open(FL)
- With xB.Sheets(1)
- R = .[B65536].End(xlUp).Row
- If R < 7 Then MsgBox "報表無 MONBR 資料！": Exit Sub
- Arr = .Range("B7:B" & R)
- For i = 1 To UBound(Arr)
- T = Right(Arr(i, 1), 7): Arr(i, 1) = ""
- If xD(T) = 1 Then Arr(i, 1) = "V"
- Next i
- With .Range("N7:N" & R): .Value = Arr: .Select: End With
- End With
-
- DT(2) = DT: DT = Now
- MsgBox "派出結果至報表已完成，確定無誤後儲存再關閉檔案！":
- End Sub
-
- '＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
- Private Function CheckBookOpen(BookName$) As Long '副程式-檢查檔案是否開啟中
- On Error Resume Next
- Open BookName For Binary Access Write Lock Write As #1
- Close #1
- CheckBookOpen = Err.Number
- On Error GoTo 0
- End Function
 報表v01.rar (381.29 KB)
|
|
發表於 2015-9-23 22:16
| 
