我有一张名称,SSN和4列填充了以下值的工作表:S,MB,B。
对于所述列,我希望用数字4替换S,用数字3替换MB,用数字2替换B.
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函数中,如何创建一个循环来替换每个值?
答案 0 :(得分:0)
我主要同意迈克尔 - 要学到最多,你应该自己开始,然后回过头来提出更具体的问题。但是,我希望达到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
下一级是for 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个,则顶部的if then
语句可防止出现错误。如果每个文件的页数变化,那么这将是有用的,如果数字是固定的,只需调整循环停止和正确的位置。当然,这假设您的工作簿有多张表的信息。如果没有完全跳过循环。
我相信很多人会批评我使用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
答案 1 :(得分:-1)
我将对此进行高级别的解释;实施将取决于你。您将从一个抓取工具开始逐个打开所有这些文件(谷歌搜索应该可以帮助您)。 我不完全确定您的工作表的组织方式,但一般的想法是打开每个工作表并执行操作,因此您需要一个文件名/路径列表或按顺序执行。然后,一旦在文件内部,假设结构与每个结构相同,您将抓住列并输入适当的值,然后保存并关闭文件。 如果您正在寻找如何打开VBA编辑器,请转到选项并启用“开发人员”选项卡。 这是一个很好的初学者项目,虽然你可能会遇到困难,但你会在这个过程中学到很多东西。