Excel VBA值在替换后保持字符串格式

I am a total newbie in Excel VBA. I find a script that can help me map data from one worksheet to another, but after the mapping is done, the value format just changed.

I have two sheets, Sheet 1 is the raw data sheet, and Master Data sheet is where the mapping data are stored. Please see the table structures below:

Sheet 1:
Description:
Home Use
Business Owner
Professional
CFO
Secretary

Master Data sheet:
code Description
001 Home Use
002 Business Owner
003 Professional
004 CFO
005 Secretary

As you may see the values in the first column in the Master Data sheet are in text format, ie 001, 002, etc

The code below does the trick to map the data in the first column in Master Data sheet and use them to replace the description in Sheet 1.

Sub mapping()

Dim rng1 As Range, rng2 As Range, cel As Range  
Dim StrMyChar As String, StrMyReplace As String

With ActiveWorkbook.Worksheets("Master Data")
    Set rng1 = .[B1:B5]
End With

With ActiveWorkbook.Worksheets("Sheet1")
    Set rng2 = .[A2:A6]
End With

'loop down list of texts needing replacing
For Each cel In rng1.Cells
    StrMyChar = cel.Value
    StrMyReplace = cel.Offset(0, -1).Value

    'replace text
    With rng2
        .Replace What:=StrMyChar, Replacement:=StrMyReplace,_  
         SearchOrder:=xlByColumns, MatchCase:=False
    End With
    'Next word/text to replace
Next cel

End Sub  

After running the code, I find all the 001, 002, etc all got changed to 1, 2, etc.
Is there a way for me to preserve the 001 string format?
Thanks.

解决方案

Try this below. Note that it still forces the replacement format, so that the values in the cells are still technically numbers. This is a drawback of Excel's replace functionality--its just how it works because it wants to assume that everything is numeric.

Note that you also had the rng1 set to the wrong range, it should be b2-b6 not b1-b5

        With ActiveWorkbook.Worksheets("Master Data")
            Set rng1 = .[B2:B6] ' Note that you had the wrong range here
        End With

        'this will force two leading zeros if necessary call it before the replace
        Application.ReplaceFormat.NumberFormat = "00#" 

        'then add ReplaceFormat:=true to your replace string
        .Replace What:=StrMyChar, Replacement:=StrMyReplace, _
                 SearchOrder:=xlByColumns, MatchCase:=False, ReplaceFormat:=True

Unfortunately ReplaceFormat.NumberFormat = "@" does not work with Excel's built in replace. The better option if we don't want to mess with Excel's built in replace method, we can do it ourselves, quick and easy:

Option Compare Text 'use this for case insensitive comparisons
Sub Mapping()

    Dim rngLookup As Range
    Set rngLookup = ActiveWorkbook.Worksheets("Master Data").[B2:B6]

    Dim rngReplace As Range
    Set rngReplace = ActiveWorkbook.Worksheets("Sheet1").[A2:A6]

    Dim cell As Range, cellLookup As Range
    For Each cell In rngReplace
        Dim val As String
        val = cell.Value
        For Each cellLookup In rngLookup
            If cellLookup.Value = val Then
                cell.NumberFormat = "@"
                cell.Value = cellLookup.Offset(0, -1).Value
                Exit For
            End If
        Next
    Next
End Sub

This code loops through each line in your Sheet 1, and then searches for the proper entry in the master sheet, but sets the Number Format to "@" before it copies it. You should be good.

If you are going to have to work with a LOT of cells, consider turning Application.ScreenUpdating off before running the procedure, and back on after. This will speed things up as it doesn't have to worry about rendering to the screen while it is working.

Another, non VBA idea that keeps both the original value and adds data next to it:

You could also get this information (albeit in a different column) using a Vlookup without any VBA code. If you switch your Descriptions to Column A and your Codes to Column B on the Master Sheet, you can then go to Sheet1, highlight the cells in Column B and type this formula:

=VLOOKUP(A2:A6,'Master Data'!A2:B6,2,FALSE)

Do not hit enter, but rather hit Control+Shift+Enter. This creates what is called an Array formula. This doesn't do a replace for you, but offers the data in the column next to it. Just throwing this out there as some extra information if you needed another way of getting it.

You could also set the formula for a cell in VBA using the Range.Formula property and setting it to the vlookup formula above