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