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方法

<span style="white-space:pre"></span><pre name="code" class="html">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 BooleanOn 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 FunctionProc_Err:    MsgBox err.DescriptionEnd Function