Excel VBA 数据替换

 

源文件.xlsx 有两列数据,一个是原始值,一列是替代值

根据实际数据行修改

nValueCount = 597

修改后的数据填充为了蓝色

---------------------------------------

Private Sub MyReplace()
Application.ScreenUpdating = False
Dim MyPath,MyFile, sht As Worksheet

MyPath = ThisWorkbook.Path & "\"
MyFile = Dir(MyPath & "*.xls")
Dim nRow As Long
Dim nColumn As Long

Dim SheetName As String
Dim cellValue As String
Dim nValueCount As Integer
nValueCount = 597
Dim 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
    .Close
End With


Dim cellRange As Range
Dim curCellRange As Range
Dim 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 If
MyFile = Dir
Loop
Application.ScreenUpdating = True
End Sub

 

 ---------------------------------------------------------------

希望对经常用Excel处理数据的人有用。

 

posted @   咸鱼翻身  阅读(891)  评论(0编辑  收藏  举报
编辑推荐:
· Linux系列:如何用 C#调用 C方法造成内存泄露
· AI与.NET技术实操系列(二):开始使用ML.NET
· 记一次.NET内存居高不下排查解决与启示
· 探究高空视频全景AR技术的实现原理
· 理解Rust引用及其生命周期标识(上)
阅读排行:
· 物流快递公司核心技术能力-地址解析分单基础技术分享
· .NET 10首个预览版发布:重大改进与新特性概览!
· 单线程的Redis速度为什么快?
· 展开说说关于C#中ORM框架的用法!
· Pantheons:用 TypeScript 打造主流大模型对话的一站式集成库
点击右上角即可分享
微信分享提示