源文件.xlsx 有两列数据，一个是原始值，一列是替代值
根据实际数据行修改
nValueCount = 597
修改后的数据填充为了蓝色
—————————————
Private Sub MyReplace()Application.ScreenUpdating = FalseDim MyPath$, MyFile$, sht As Worksheet
MyPath = ThisWorkbook.Path & “\”MyFile = Dir(MyPath & “*.xls”)Dim nRow As LongDim nColumn As Long
Dim SheetName As StringDim cellValue As StringDim nValueCount As IntegernValueCount = 597Dim oldValue()Dim newValue()
ReDim oldValue(nValueCount)ReDim newValue(nValueCount)
Dim sht2
With Workbooks.Open(ThisWorkbook.Path & “\源文件.xlsx”) Set sht2 = .Worksheets(1) With sht2 For i = 2 To nValueCount + 2 oldValue(i – 2) = .Cells(i, 1) newValue(i – 2) = .Cells(i, 2) Next End With .CloseEnd With
Dim cellRange As RangeDim curCellRange As RangeDim Hasf As Variant
Do While MyFile <> “” If MyFile <> ThisWorkbook.Name And MyFile <> “源文件.xlsx” Then With Workbooks.Open(MyPath & MyFile) For Each sht In .Worksheets With sht Set cellRange = sht.UsedRange SheetName = sht.Name nRow = cellRange.Rows.Count nColumn = cellRange.Columns.Count For i = 1 To nColumn For j = 1 To nRow Set curCellRange = .Cells(j, i) If curCellRange.HasFormula Then ‘Hasf = Rng.Formula Exit For Else ‘Hasf = “” End If
cellValue = .Cells(j, i) For k = 0 To nValueCount If oldValue(k) = cellValue Then .Cells(j, i) = newValue(k) curCellRange.NoteText ‘Joker’ curCellRange.Interior.Color = RGB(0, 0, 255) Exit For End If Next ‘.Cells(j, i) Next Next
End With Next ‘.Save ‘.Close True End With End IfMyFile = DirLoopApplication.ScreenUpdating = TrueEnd Sub
—————————————————————
希望对经常用Excel处理数据的人有用。
在乎的是沿途的风景以及看风景的心情，让心灵去旅行！
