PJChen

回復 8# 准提部林
回復 10# ChuckBucket

二位好,
這段時間,一有機會就進行測試,但無論如何,程式執行結果還是有問題,請幫忙解惑... 測試2.rar (48.68 KB)

下載次數: 2

2019-5-17 20:38

執行程式的問題:(我把執行結果留在檔案中,希望有助於了解原因)
執行後只有3個檔,卻列了100多行
只測了3個檔,但Run得有點久,不知問題出在哪?
執行後不需要把檔案名稱列出來
本來自行把以下二行變成註解,但還是會寫在其他欄位,請問該如何修改程式,才能讓它不要把檔案名稱列出?
[F1:H999].ClearContents:  Set xA = [F1]
If Not xS Is Nothing Then xS.Range(R) = T: xB.Save: xA(1, 3) = "(V)寫入完成"
當資料夾變更路徑時,該如何修改寫法?例如:路徑改為W:\0_自訂表單\日常表格\
與程式不在同一資料夾時?

准提部林

回復 11# PJChen


Sub 測試()
Dim P$, S$, T$, R$, F$, N&, xB As Workbook, xS As Worksheet
P = [B6]: If P = "" Then MsgBox "**資料夾名稱,子資料夾未輸入!　": Exit Sub
P = ThisWorkbook.Path & "\" & P & "\"
If Dir(P, vbDirectory) = "" Then MsgBox "**子資料夾不存在!　": Exit Sub
S = [B2]: If S = "" Then MsgBox "**工作表名稱未輸入!　": Exit Sub
T = [B4].Text: If S = "" Then MsgBox "**寫入的內容未輸入!　": Exit Sub
R = [B5]: If R = "" Then MsgBox "**寫入位址未輸入!　": Exit Sub
On Error Resume Next: Set xA = Range(R): On Error GoTo 0
If xA Is Nothing Then MsgBox "**寫入位址不正確!　": Exit Sub
If xA.Count > 1 Then MsgBox "**寫入位址不是單一儲存格!　": Exit Sub
'--------------------------------------------------------------------
Dim xD, A
Set xD = CreateObject("Scripting.Dictionary")
Do
   If F = "" Then F = Dir(P & "*.xlsx") Else F = Dir()
   If F = "" Then Exit Do Else xD(F) = ""
Loop
If xD.Count = 0 Then Exit Sub
Application.ScreenUpdating = False
For Each A In xD.keys
    Set xB = Workbooks.Open(P & A):  Set xS = Nothing
    On Error Resume Next: Set xS = xB.Sheets(S): On Error GoTo 0
    If Not xS Is Nothing Then xS.Range(R) = T: xB.Save
    xB.Close 0
Next
End Sub

===================

PJChen

回復 12# 准提部林

謝謝准大,

程式執行沒問題了,我試著把路徑變更成這樣,已經可以用了！
Path = "W:\私\範例\"
P = Path & "\" & P & "\"

准提部林

回復 13# PJChen


Path = "W:\私\範例\"
P = Path & "\" & P & "\"

紅色部份重覆兩個"\",  刪掉其中一個~~~

PJChen

回復 14# 准提部林

好的,感謝！