儲存格索引值 - Excel程式區 - 麻辣家族討論版版

PJChen

　暱稱: PJ

大學生 Rank: 4

帖子: 913
主題: 150
精華: 0
積分: 1089
點名: 0
作業系統: win10
軟體版本: office 2019
閱讀權限: 50
性別: 女
註冊時間: 2011-8-28
最後登錄: 2023-7-19

論壇榮譽勳章論壇贊助勳章

11^# 跳轉到 »

發表於 2019-5-17 20:39 | 只看該作者

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

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

測試2.rar (48.68 KB)

執行程式的問題:(我把執行結果留在檔案中,希望有助於了解原因)
執行後只有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_自訂表單\日常表格\
與程式不在同一資料夾時?

TOP

准提部林

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 2798
主題: 10
精華: 0
積分: 2854
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2024-4-15

12^#

發表於 2019-5-18 09:31 | 只看該作者

回復 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

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

TOP

PJChen