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_ErrRem 参数说明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 StringDoVLoopUp2 = FalseWith rngRefIf RefWorkBookName <> "" ThenstrRefBookSheeName = "'[" & RefWorkBookName & "]" & rngRef.Worksheet.Name & "'!"ElsestrRefBookSheeName = "'" & rngRef.Worksheet.Name & "'!"End IfstrRefAddress = strRefBookSheeName & "R" & .row & "C" & .Column & ":R" & .row + .Rows.Count - 1 & "C" & .Column + .Columns.Count - 1End WithstrVLookUp = "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 = strVLookUpDoVLoopUp2 = TrueExit FunctionProc_Err:MsgBox err.DescriptionEnd Function