關於批次處理儲存格問題 求大家幫忙解惑

rbktwi

大家好
小弟初學excel vba不久，有個批次更改儲存格程式問題想請各位幫忙解答。

不知道能否利用VBA寫一程式，讓"某指定資料夾"內所有excel檔案的某儲存格內容(EX:"A1")，填入固定數值(EX:"123")。

以上程式操作是否只能以API達到呢?  VBA也行?

如VBA可行，請大家幫幫忙建議該用那些函數撰寫。 非常感謝~

PKKO

回復 1# rbktwi

test.rar (29.5 KB)

下載次數: 3

2015-1-6 20:31

1. Sub 巨集1()
   
2.     Application.ScreenUpdating = False '關閉螢幕
   
3.     ' myfloder="您的檔案路徑包含最後一個要\"
   
4.     w1 = ActiveWorkbook.Name
   
5.     '若是想要找到這個EXCEL檔案的所在目錄就使用
   
6.     Dim WrdArray() As String
   
7.     myfloder = ""
   
8.     WrdArray() = Split(ThisWorkbook.FullName, "\")
   
9.     For i = 0 To UBound(WrdArray) - 1
   
10.         myfloder = myfloder & "\" & WrdArray(i)
    
11.     Next i
    
12.     myfloder = Mid(myfloder, 2, Len(myfloder) - 1) & "\"
    
13.    
    
14.     '找出所有檔案名稱
    
15.     FILE1 = Dir(myfloder)
    
16.     Do While FILE1 <> ""
    
17.         ar = ar & "," & FILE1 '(沒指定哪種檔案的EXCEL)
    
18.         FILE1 = Dir '取得下一個檔名
    
19.     Loop
    
20.     ar = Split(Mid(ar, 2, 100000), ",") '拆開第一個,
    
21.     '跑每個EXCEL檔
    
22.     For Each e In ar
    
23.         If e <> w1 Then '不執行自己本的檔案
    
24.             Workbooks.Open (myfloder & e)
    
25.                 Cells(1, 1) = "123" 'A1輸入值(沒指定SHEET)
    
26.             ActiveWindow.Close saveChanges:=True '關閉且儲存
    
27.         End If
    
28.     Next
    
29.     Application.ScreenUpdating = True '恢復螢幕
    
30. End Sub

複製代碼

rbktwi

感謝Bob幫忙 晚點來調試

可否另外再請教 如果EXCEL檔案一打開會跳出類似 啟用巨集or問要不要更新連結等等之類選項的話,要怎麼讓vba去選擇動作呢?  例如選擇啟動巨集 or 選擇不要更新 再次感謝

PKKO

回復 3# rbktwi

一、啟動巨集需要人為操作,避免病毒不需要經過您的同意,執行病毒碼
可在安全性設定,設定完畢後關閉,再打開時就會是您設定的結果,若設定最低,則會無條件直接啟動巨集

二、連結的部分
在ThisWorkbook的模組裡面,Workbook_Open的事件內
設定    Application.AskToUpdateLinks=False '代表不會詢問
設定   Workbook.UpdateLinks =False ''代表不會啟動連結

反之亦如~
試試看,有錯誤請不吝糾正!

rbktwi

回復 4# PKKO

原來如此~ 非常感謝Bob幫忙解惑 受益良多~

rbktwi

不好意思 想再請問Bob
關於搜尋儲存格 以下程式碼
  '跑每個EXCEL檔
   For Each e In ar
        If e <> w1 Then '不執行原先開啟的檔案
            Workbooks.Open (myfloder & e)
               s = Worksheets.Count
                    For j = 1 To s
                    Find = ActiveWorkbook.sheets(j).cells.Find(What:="Exchange Rate:", After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, MatchByte:=False, SearchFormat:=False).Activate
Next
        End If
    Next
我想做的是參照作用中活頁簿 接著輪流搜尋參照作用中活頁簿的各工作表
但excel顯示物件不支援此功能 請問我該用哪一種屬性呢?

rbktwi

已解決~
   Dim fr As Range
   Dim sh As Worksheet
    For Each e In ar
    If e <> w1 Then
    Workbooks.Open (myfloder & e)
            For Each sh In ActiveWorkbook.Worksheets
                Set fr = sh.Cells.Find(what:="Exchange Rate:", After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, MatchByte:=False, SearchFormat:=False)
                    If Not fr Is Nothing Then
                               Msgbox fr.Name
                    End If
            Next sh
    ActiveWindow.Close saveChanges:=True '關閉且儲存
    End If
    Next e