用新值替换所有工作表中的值 [英] Replace values across ALL worksheets with new value

问题描述

我有大约40个电子表格，每个电子表格最多包含300k行x 93列（当前）。那就是大约11亿的数据点。我需要检查每个单元格，并确定该单元格是否包含8个特殊字符之一，这在导入电子表格时已被弄乱。

这是一个需要每天多次运行的任务，以及其他一些步骤。因此，我正在寻找一种方法来使用VBA。我有以下代码：

  Sub Hide_All_Sheets（）
 
 Application.ScreenUpdating = False 
 Application.DisplayAlerts = False 
 Application.DisplayStatusBar = False 
 
 Dim k As Integer 
 Dim t As String 
 Dim x As Integer 
 
k = Sheets.Count 
x = 1 
 
虽然x <= k 
t = Sheets（x）.Name 
如果t =启动屏幕或t = Equiv sheet然后
x = x + 1 
 ElseIf t =Summary_1和工作表（启动屏幕）。范围（N5）=1然后
表格）.Visible = True 
x = x + 1 
 Else 
 
 Cells.Replace什么：=ö，替换：= Chr（214），LookAt：= xlPart， _ 
 SearchOrder：= xlByRows，MatchCase：= True，SearchFormat：= False，_ 
 ReplaceFormat：= False 
 Cells.Replace什么：=¼，替换：= Chr（220） ，LookAt：= xlPart，_ 
 SearchOrder：= xlByRows，MatchCase：= True，Sear chFormat：= False，_ 
 ReplaceFormat：= False 
 Cells.Replace什么：=ä，替换：= Chr（220），LookAt：= xlPart，_ 
 SearchOrder = xlByRows，MatchCase：= True，SearchFormat：= False，_ 
 ReplaceFormat：= False 
 Cells.Replace什么：=ß，替换：= Chr（223），LookAt：= xlPart，_ 
 SearchOrder：= xlByRows，MatchCase：= True，SearchFormat：= False，_ 
 ReplaceFormat：= False 
 Cells.Replace什么：=Ã，替换：= Chr（200） LookAt：= xlPart，_ 
 SearchOrder：= xlByRows，MatchCase：= True，SearchFormat：= False，_ 
 ReplaceFormat：= False 
 Cells.Replace什么：=Ã，替换： = Chr（223），LookAt：= xlPart，_ 
 SearchOrder：= xlByRows，MatchCase：= True，SearchFormat：= False，_ 
 ReplaceFormat：= False 
 Cells.Replace什么： Ã，替换：= Chr（223），LookAt：= xlPart，_ 
 SearchOrder：= xlByRows， MatchCase：= True，SearchFormat：= False，_ 
 ReplaceFormat：= False 
 
表格（x）.Visible = False 
x = x + 1 
 End If 
 
 Wend 
 
 End Sub 
  

只有问题是它将加载过程从20秒变为900秒。

我想知道有没有办法更快地做到这一点？特别是如果有办法运行手动CTRL-H进程，并在所有电子表格中替换，但是使用VBA？

解决方案

11亿个工作还有很多工作要做。您的代码对于循环遍历每个工作表广告是有条理的，替换输入中已损坏的七个（不 8）特殊字符。

以下使用工作簿范围的方法通过工作表集合替换循环。这可能有助于保留待处理信息的加载。

  Sub Repair_All_Worksheets（）
 Dim fr As Long，FandR As Variant，vWSs As Variant 
 
 appTGGL bTGGL：= False 
 
 FandR = Array（¶，Chr（214），¼，Chr （220），Ã，Chr（220），Ã，Chr（223），_ 
Ã，Chr（200），Ã，Chr（223） ，Chr（223））
 
使用ActiveWorkbook 
 ReDim vWSs（1 To .Worksheets.Count）
对于fr = LBound（vWS）到UBound（vWS）
 vWSs（fr）= .Worksheets（fr）.Name 
下一步fr 
 
带有.Worksheets（vWS）
。选择
 .Parent.Worksheets（vWSs 1））。激活
对于fr = LBound（FandR）到UBound（FandR）步骤2 
 Cells.Replace什么：= FandR（fr），替换：= FandR（fr + 1），LookAt： = xlPart 
下一个fr 
结束
结束
 
 appTGGL 
 
 End Sub 
 
 Public Sub appTGGL（可选bTGGL As Boolean = True）
 Debug.Print计时器
应用程序
 .ScreenUpdating = bTGGL 
 .EnableEvents = bTGGL 
。 DisplayAlerts = bTGGL 
 .Calculation = IIf（bTGGL，xlCalculationAutomatic，xlCalculationManual）
 End with 
 End Sub 
  

Application.EnableEvents属性与其他环境变量一起被禁用。 Application.Calculation 同样被暂时暂停到 xlCalculationManual 。这对于具有易失性功能的工作表尤其重要，这在这里似乎不是这种情况。

btw，当导入数据时，文本导入向导允许您指定代码页在文件原始文本框中的第一页上。将此设置为正确的区域代码页（或可能只有65001：Unicode（UTF-8））应修复导入以开始。 Workbooks.OpenText方法具有类似的选项。

I have about 40 spreadsheets, each containing up to 300k rows x 93 columns (currently). That is about 1.1 billion data points. I need to check through each cell, and determine if the cell contains one of 8 special characters, that has been messed up on the importation of the spreadsheet.

This is a task that needs to be run multiple times daily, along with a number of other steps. As such, I'm looking for a way to do this using VBA. I have the following code:

Sub Hide_All_Sheets()

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.DisplayStatusBar = False

Dim k As Integer
Dim t As String
Dim x As Integer

k = Sheets.Count
x = 1

    While x <= k
        t = Sheets(x).Name
        If t = "Launch Screen" Or t = "Equiv sheet" Then
            x = x + 1
        ElseIf t = "Summary_1" And Worksheets("Launch Screen").Range("N5") = "1" Then
            Sheets(x).Visible = True
            x = x + 1
        Else

            Cells.Replace What:="ö", Replacement:=Chr(214), LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
            ReplaceFormat:=False
            Cells.Replace What:="ü", Replacement:=Chr(220), LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
            ReplaceFormat:=False
            Cells.Replace What:="ä", Replacement:=Chr(220), LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
            ReplaceFormat:=False
            Cells.Replace What:="ß", Replacement:=Chr(223), LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
            ReplaceFormat:=False
            Cells.Replace What:="è", Replacement:=Chr(200), LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
            ReplaceFormat:=False
            Cells.Replace What:="Ü", Replacement:=Chr(223), LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
            ReplaceFormat:=False
            Cells.Replace What:="Ä", Replacement:=Chr(223), LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
            ReplaceFormat:=False

            Sheets(x).Visible = False
            x = x + 1
        End If

    Wend

End Sub

Only problem is that it turns the load process from being 20 seconds to 900 seconds.

I'm wondering is there a way to do this faster? Especially if there is a way to run the manual CTRL-H process, and replace across all spreadsheets, but using VBA?

解决方案

1.1 billion tasks is still a lot of work to do. Your code is methodical about looping through each worksheet ad replacing each of the seven (not 8) special characters that were corrupted on the input.

The following uses a workbook-wide method to replace the loop through the worksheets collection. This may help by retaining the 'load' of the information to be processed.

Sub Repair_All_Worksheets()
    Dim fr As Long, FandR As Variant, vWSs As Variant

    appTGGL bTGGL:=False

    FandR = Array("ö", Chr(214), "ü", Chr(220), "ä", Chr(220), "ß", Chr(223), _
              "è", Chr(200), "Ü", Chr(223), "Ä", Chr(223))

    With ActiveWorkbook
        ReDim vWSs(1 To .Worksheets.Count)
        For fr = LBound(vWSs) To UBound(vWSs)
            vWSs(fr) = .Worksheets(fr).Name
        Next fr

        With .Worksheets(vWSs)
            .Select
            .Parent.Worksheets(vWSs(1)).Activate
            For fr = LBound(FandR) To UBound(FandR) Step 2
                Cells.Replace What:=FandR(fr), Replacement:=FandR(fr + 1), LookAt:=xlPart
            Next fr
        End With
    End With

    appTGGL

End Sub

Public Sub appTGGL(Optional bTGGL As Boolean = True)
    Debug.Print Timer
    With Application
        .ScreenUpdating = bTGGL
        .EnableEvents = bTGGL
        .DisplayAlerts = bTGGL
        .Calculation = IIf(bTGGL, xlCalculationAutomatic, xlCalculationManual)
    End With
End Sub

The Application.EnableEvents property is disabled along with the other environment variables. The Application.Calculation is likewise temprarily suspended to xlCalculationManual. This would be especially important to a worksheet with volatile functions which does not seem to be the case here.

btw, when importing data the Text Import Wizard allows you to specify the codepage on the first page within the File origin: text box. Setting this to the correct regional codepage (or possibly just 65001: Unicode (UTF-8)) should fix your import to start with. The Workbooks.OpenText method has similar options.

这篇关于用新值替换所有工作表中的值的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！