VBA Excel值数据替换

'    数据替换（原始列右侧数值版）
    Dim stReplace As Worksheet, stReplaceTextVersion As Worksheet, cReplace As Integer, rReplaceOrder As Integer
'    Application.StatusBar = "正在处理数据替换"
'    Application.ScreenUpdating = False
'    Application.Calculation = xlCalculationManual
    sNew.Activate
    sNew.Copy After:=sNew
    Set stReplace = bkData.ActiveSheet
    stReplace.Name = "数据替换"
'    删除不排序的列
    For cReplace = stReplace.UsedRange.Columns.Count To 1 Step -1
        orderName = Trim(stReplace.UsedRange.Cells(1, cReplace))
        If orderName <> "" Then
            rReplaceOrder = fun.getRow(stConfigColumnsOrder, orderName, 2)
            If rReplaceOrder < 1 Then
                stReplace.UsedRange.Columns(cReplace).Offset.Delete Shift:=xlToLeft
            End If
        End If
    Next cReplace
    orderName = ""
    bkData.Worksheets.Add After:=stReplace
    Set stReplaceTextVersion = bkData.ActiveSheet
    stReplaceTextVersion.Name = "数据替换数值版"
    
    Dim rColumn As Integer, cStData As Integer, colInStReplaceTextVersion As Integer
    Dim repName As String, rData As Integer, newName As String
    Dim rngReplaceSrc As Range, rngReplaceDes As Range, errMsg As String, lon As Long
    colInStReplaceTextVersion = 0
    For rColumn = 2 To stConfigColumnsOrder.UsedRange.Rows.Count
        repName = Trim(stConfigColumnsOrder.Cells(rColumn, 1))
        If (repName <> "") Then
            cStData = fun.getColumn(stReplace, 1, repName)  '将sNew替换stReplace
            rData = fun.getRow(stConfigMapping, repName, 1)
            newName = Trim(stConfigMapping.Cells(rData, 2))
            If cStData <= 0 Then
                'MsgBox "bad"
                'Stop
            Else
                colInStReplaceTextVersion = colInStReplaceTextVersion + 1
                If Trim(stConfigColumnsOrder.Cells(rColumn, 3)) = "N" Then
'                    Set rngReplaceDes = stReplace.Columns(cStData)
                    stReplace.Activate
                    Set rngReplaceDes = stReplace.Range(Cells(1, cStData), Cells(stReplace.UsedRange.Rows.Count, cStData)) '将sNew替换stReplace
                Else
                    Call fun.getColumnByName(stReplace, 1, repName, rngReplaceSrc, errMsg, False)
                    rngReplaceSrc.Offset(, 1).Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
                    Set rngReplaceDes = rngReplaceSrc.Offset(, 1)
                    Set rngReplaceDes = rngReplaceDes.Resize(stReplace.UsedRange.Rows.Count)
                    'Set rngReplaceDes = rngReplaceSrc(Cells(1, 1), Cells(rngReplaceSrc.Rows.Count, 1))
                    'todo:stConfigMapping.UsedRange改为实际上的字典区域
                    lookup.DoVLoopUp2 rngReplaceDes, stConfigMapping.UsedRange, rngReplaceSrc.Column, 2, "", stConfigMapping.Parent.Name
                End If
                
                If newName <> "" Then
                    rngReplaceDes.Cells(1, 1) = newName '替换表头
                Else
                    rngReplaceDes.Cells(1, 1) = repName '如果为空，则列名不变
                End If
                
                rngReplaceDes.Copy
                stReplaceTextVersion.Cells(1, colInStReplaceTextVersion).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'                rngReplaceDes.Cells(1, 1).Copy
'                stReplaceTextVersion.Activate
'                stReplaceTextVersion.Columns(colInStReplaceTextVersion).Select
'                ActiveSheet.Paste
                stReplaceTextVersion.Cells(1, colInStReplaceTextVersion).Interior.Color = rngReplaceDes.Cells(1, 1).Interior.Color '设置表头颜色
            End If
        End If
    Next
    
    Application.StatusBar = ""
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    
    stReplace.UsedRange.Font.Name = "Arial"  '设置该Sheet字体样式
    stReplace.Cells.EntireColumn.AutoFit
    stReplace.UsedRange.Select
    stReplaceTextVersion.Cells.Font.Name = "Arial"  '设置该Sheet字体样式
    stReplaceTextVersion.Cells.EntireColumn.AutoFit
    stReplaceTextVersion.Activate
    stReplaceTextVersion.UsedRange.Select

以下是VlookUp方法

	
Public Function DoVLoopUp2(rngDes As Range, rngRef As Range, lookup_value_inDes As Integer, col_index_inRef As Integer, _
        Optional error_value As String = "", Optional RefWorkBookName As String = "") As Boolean
On Error GoTo Proc_Err
    Rem 参数说明
Rem lookup_value_inDes是目标worksheet的参照列，用绝对地址表示
'如下面是目标表，其中中的C列需要根据B列（就是第2列）来进行参照
'A      B       C
'1      张三
'2      李四

Rem col_index_inRef，是相对值
'如参照表是
'A      B
'张三   22
'李四   29
'
'则所用的参数分别是：DoVLookUp2(rngDes,rngRef,2,2)，第一个2表示参照B列，第二个2是指取参照表的第2列
    
    Dim strVLookUp As String, strLookAddress As String, strRefAddress As String, strRefBookSheeName As String
    DoVLoopUp2 = False
    With rngRef
        If RefWorkBookName <> "" Then
            strRefBookSheeName = "'[" & RefWorkBookName & "]" & rngRef.Worksheet.Name & "'!"
        Else
            strRefBookSheeName = "'" & rngRef.Worksheet.Name & "'!"
        End If
        strRefAddress = strRefBookSheeName & "R" & .row & "C" & .Column & ":R" & .row + .Rows.Count - 1 & "C" & .Column + .Columns.Count - 1
    End With
    
    strVLookUp = "VLOOKUP(RC" & lookup_value_inDes & "," & strRefAddress & "," & col_index_inRef & ",FALSE)"
    strVLookUp = "=IF(RC[-1]="""","""",IF(ISERROR(" & strVLookUp & ")=TRUE," & error_value & "," & strVLookUp & " &""""))"
'    strVLookUp = "=IF(ISERROR(" & strVLookUp & ")=TRUE," & error_value & "," & strVLookUp & " &"""")"
    rngDes.FormulaR1C1 = strVLookUp
    DoVLoopUp2 = True
    Exit Function
Proc_Err:
    MsgBox err.Description
End Function