替换单元格中的文本

时间:2016-06-10 16:31:40

标签: excel vba

我有一张名称,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函数中,如何创建一个循环来替换每个值?

2 个答案:

答案 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编辑器,请转到选项并启用“开发人员”选项卡。 这是一个很好的初学者项目,虽然你可能会遇到困难,但你会在这个过程中学到很多东西。