VBA宏的Excel

Question

我從來沒有做過的宏之前，所以請原諒，而我試圖解釋我想要完成的任務：

我有，有一些names和SSN's片，然後有4列裝滿以下值：S,MB，B。

對於列說我想用3號和B與數字2我有成千上萬的Excel文件，這些文件需要這個變化數4，MB更換S並用CTRL+F做手工和更換爲每個Excel表格都不會按時切換。

編輯

我有以下至今：

Sub replace() 
    Dim str1, str2, str3, filename, pathname As String 
    Dim i As Integer 

    str1 = "MB" 
    str2 = "B" 
    str3 = "S" 
    filename = "p" 
    pathname = ActiveWorkbook.Path 
    i = 1 


    Do While filename <> "" 
     Set wb = Workbooks.Open(pathname & filename + i) 
     DoWork wb 
     wb.Close SaveChanges:=True 
     filename = Dir() 
    Loop 

End Sub 

Sub DoWork(wb As Workbook) 
    With wb 

    End With 
End Sub 

的功能DoWork的如何創建一個循環來代替每個值

？

Answer 1

我會提供一個高層次的解釋;實施將取決於你。您將開始使用抓取工具逐一打開所有這些文件（谷歌搜索應該可以幫助您解決這個問題）。 我不完全確定你的工作表是如何組織的，但總體思路是打開每個工作表並執行操作，因此您需要一個文件名/路徑列表或按順序執行。然後，一旦假設結構與每個結構相同，一旦進入該文件，您將獲取該列並輸入適當的值，然後保存並關閉該文件。 如果您正在尋找如何打開VBA編輯器，請轉到選項並啓用「開發人員」選項卡。 這是一個很好的初學者項目，雖然你可能會掙扎，但你會在這個過程中學到很多東西。

Answer 2

我大多數人都同意邁克爾 - 要學習最多的東西，你應該自己開始，然後再回答更具體的問題。但是，我期待達到50代表，所以我會迎接你。但請務必仔細閱讀代碼並理解它。

你的名字暗示你是程序員，所以我們使用的概念應該是熟悉的。我想從裏面出來工作，所以這裏有雲：

這裏是我的變量：

Dim sFileName As String 
Dim sFilePath As String 
Dim wbBook  As Excel.Workbook 
Dim i   As Double 
Dim wsSheet  As Excel.Worksheet 
Dim rRange  As Range 
Dim c   As Range 
Dim dReplace As Double 

在覈心，你會想要一個select case語句來讀取每個細胞，並決定哪些新價值應該。然後，你將新的值賦給單元：

Select Case c.value 'c being the cell we are currently examining 
    Case "S" 
     dReplace = 4 
    Case "M" 
     dReplace = 3 
    Case "B" 
     dReplace = 2 
    Case Else 
     'Assuming you should only encounter the above values, 
     'then anything else is an error 
     '.assert false will stop the code, or you can replace 
     'with more refined error handling 
     Debug.Assert False 
End Select 
c.value = dReplace 

周圍，你會想要一個for each循環通過您指定特定的工作表中的所有單元格範圍定義當前單元格並重復：

set rRange = wsSheet.Range("C2:E5000") 'Customize to your range 
for each c in rRange.Cells 

    '... 

next 

下一級別是爲next loop通過在當前文件中的所有工作表迭代：

For i = 1 To 30 
    If wbBook.Sheets(i).Name = "" Then 
     GoTo NextOne 
    End If 

    Set wsSheet = wbBook.Sheets(i) 

    '... 

NextOne: 
Next i 

的如果工作簿中的工作表少於30個，則頂部的3210語句可防止發生錯誤。如果每個文件的頁數有所不同，那麼這將是有用的，如果數量是固定的，只需調整循環停止和正確的位置。當然，這假定您的工作簿具有多個工作表的信息。如果不是完全跳過循環。

我敢肯定，很多人會批評我使用goto，但由於VBA循環缺少continue命令，這是我採用的解決方法。

在此之前，您需要另一個迭代器遍歷多個文件。假設它們都在同一個文件夾中，可以使用Dir()函數逐個獲取文件名。你給它的文件路徑和（可選）文件類型，它會返回它找到的第一個文件名，以滿足你的cirteria。再次運行它，並返回第二個文件名等。將其分配給字符串變量，然後使用文件路徑和文件名打開工作簿。使用do loop繼續下去，直到用完文件：

sFilePath = "C:\Your File Path Here\" 
sFileName = Dir(sFilePath & "*.xlsx") 

Do Until sFileName = "" 

    Set wbBook = Workbooks.Open(sFilePath & sFileName) 

    '... 

    wbBook.Save 
    wbBook.Close 
    sFileName = Dir() 

Loop 

現在把它放在一起：

Sub ReplaceLetterCodewithNumberCode() 
    Dim sFileName As String 
    Dim sFilePath As String 
    Dim wbBook  As Excel.Workbook 
    Dim i   As Double 
    Dim wsSheet  As Excel.Worksheet 
    Dim rRange  As Range 
    Dim c   As Range 
    Dim dReplace As Double 

    Application.ScreenUpdating = False 

    sFilePath = "C:\Your File Path Here\" 
    sFileName = Dir(sFilePath & "*.xlsx") 

    Do Until sFileName = "" 

     Set wbBook = Workbooks.Open(sFilePath & sFileName) 

     For i = 1 To 30 
      If wbBook.Sheets(i).Name = "" Then 
       GoTo NextOne 
      End If 

      Set wsSheet = wbBook.Sheets(i) 
      Set rRange = wsSheet.Cells("C2:E5000") 'Customize to your range. Assumes the range will be the same 

      For Each c In rRange.Cells 
       Select Case c.value 'c being the cell we are currently examining 
        Case "S" 
         dReplace = 4 
        Case "M" 
         dReplace = 3 
        Case "B" 
         dReplace = 2 
        Case Else 
         'Assuming you should only encounter the above values, 
         'then anything else is an error 
         '.assert false will stop the code, or you can replace 
         'with more refined error handling 
         Debug.Assert False 
       End Select 
       c.value = dReplace 
      Next 
NextOne: 
     Next i 

     wbBook.Save 
     wbBook.Close 
     sFileName = Dir() 

    Loop 

    'Clean up 
    Set wbBook = Nothing 
    Set wsSheet = Nothing 
    Set rRange = Nothing 
    Set c = Nothing 
    Application.ScreenUpdating = True 

End Sub