Excel VBA中的高效低版本套件

现在我使用下面的代码将整个列更改为小写。

我想知道是否有一个更有效的方法来做到这一点 – 我的工作表中有大约150K行。

这需要一些时间来完成，有时我得到一个Out of Memory错误。

第一小组

 Sub DeletingFl() Dim ws1 As Worksheet Dim rng1 As Range Application.ScreenUpdating = False Set ws1 = Sheets("Raw Sheet") ws1.AutoFilterMode = False Set rng1 = ws1.Range(ws1.[a1], ws1.Cells(Rows.Count, "A").End(xlUp)) rng1.AutoFilter 1, "Florida" If rng1.SpecialCells(xlCellTypeVisible).Count > 1 Then Set rng1 = rng1.Offset(1, 0).Resize(rng1.Rows.Count - 1) rng1.EntireRow.Delete End If ws1.AutoFilterMode = False Call DeletingEC End Sub Sub DeletingEC() Dim ws1 As Worksheet Dim rng1 As Range Application.ScreenUpdating = False Set ws1 = Sheets("Raw Sheet") ws1.AutoFilterMode = False Set rng1 = ws1.Range(ws1.[a1], ws1.Cells(Rows.Count, "A").End(xlUp)) rng1.AutoFilter 1, "East Coast" If rng1.SpecialCells(xlCellTypeVisible).Count > 1 Then Set rng1 = rng1.Offset(1, 0).Resize(rng1.Rows.Count - 1) rng1.EntireRow.Delete End If ws1.AutoFilterMode = False Worksheets("Raw Sheet").Activate Call Concatenating End Sub 

第二小组

 Sub Concatenating() Columns(1).EntireColumn.Insert Columns(2).EntireColumn.Copy Destination:=ActiveSheet.Cells(1, 1) Dim lngLastRow As Long lngLastRow = Cells(Rows.Count, "A").End(xlUp).Row Range("A2:A" & lngLastRow).Formula = "=F2 & ""_"" & G2" Range("A1").Select ActiveCell.FormulaR1C1 = "Title" Call LowerCasing End Sub Sub Lowercasing() Dim myArr, LR As Long, i As Long LR = Range("A" & Rows.Count).End(xlUp).Row myArr = Range("A1:A" & LR) For i = 1 To UBound(myArr) myArr(i, 1) = LCase(myArr(i, 1)) Next i Range("A1:A" & LR).Value = myArr Set ExcelSheet = Nothing End Sub 

Answer 1

看起来有一点冗余，肯定是arrays的问题。

我认为你可以删除Lowercasing（）函数，并增强连接来为你做下舍入：

 Sub Concatenating() Dim lRowCount As Long Dim lngLastRow As Long 'Do this first while values in column A lngLastRow = Cells(Rows.Count, "A").End(xlUp).Row Columns(1).EntireColumn.Insert 'Meh... :P 'We're looping through code in the Lower Casing so no need to copy this and then loop through 'Columns(2).EntireColumn.Copy Destination:=ActiveSheet.Cells(1, 1) For lRowCount = 1 To lngLastRow 'I read a long time ago that LCase$ is faster than LCase; may not be noticable on today's machines 'It wont' hurt to use LCase$ Range("A" & lRowCount) = LCase$(Range("B" & lRowCount)) Next lRowCount 'Not sure what this does but may need to adjust accoringly Range("A2:A" & lngLastRow).Formula = "=F2 & ""_"" & G2" Range("A1").Select ActiveCell.FormulaR1C1 = "Title" 'No need...already lower cased 'Call Lowercasing End Sub 

Answer 2

使用电子表格来做到这一点。 我把一些数据放在$A$1:$A$384188 ，并在$B$1:$B$384188 ： {=UPPER($A$1:$A$384188)}了一个数组公式。 它是直接的，并没有使用太多的内存。

通过VBA循环总是会慢得多，而且会占用更多的内存。 您可以使用VBA创build公式并按值复制粘贴数据。

Answer 3

你有时会得到错误，因为你试图打包到一个数组中有多less东西。 您放入该arrays的所有内容都必须适合您的可用内存。

像这样的东西应该更好地工作（注意这是未经testing的代码）：

 Sub Lowercasing() Const MaxArraySize As Integer = 1000 Dim myArr, Rng As Range, LR As Long, i As Long, j As Long, ArrayLen As Integer LR = Range("A" & Rows.Count).End(xlUp).Row Application.ScreenUpdating = False For i = 1 To LR Step MaxArraySize If LR - i < MaxArraySize Then ArrayLen = LR - i + 1 Else ArrayLen = MaxArraySize End If Set Rng = Range("A" & i & ":A" & i + ArrayLen - 1) myArr = Rng For j = LBound(myArr) To UBound(myArr) myArr(j, 1) = LCase(myArr(j, 1)) Next j Rng.Value = myArr Next i Application.ScreenUpdating = True End Sub 

总的想法是在一系列较小的更新中进行更新。 您可以使用MaxArraySize常量来查找速度和内存使用情况之间的良好平衡。

您还需要添加一个error handling程序，以确保ScreenUpdating在出现问题时可以重新启用。

Answer 4

这是另一种降低列中每个单元格的方法，也许值得一试：

 Public Sub toLowerCase() Dim lr As Integer For lr = 1 To Application.ActiveSheet.UsedRange.Rows.Count Application.ActiveSheet.Cells(lr, 1) = LCase(Application.ActiveSheet.Cells(lr, 1).Value) Next lr End Sub 

不是创build一个数组并重新设置范围，而是简单地使用UsedRange并设置值。 这样就避免了对数组的需求，在处理这种大小的数据时可能会产生问题。

仅供参考…我注意到你的代码片段，你做复制。 如果您正在复制大量单元格，则设置每个单元格值（例如， cellTarget.Value = cellSource.Value ）比将一个单元格值复制到另一个单元格值要cellTarget.Value = cellSource.Value 。

另外，我注意到你将ScreenUpdating设置为False …你把它设置回True的位置？ 除了在这些大型计算过程中切换ScreenUpdating之外，您还可以考虑将“ 计算”设置为手动 。 有时当工作表得到这么多的活动时，Excel会经常计算。 通过设置这个manul，你避免了开销。

以下是使用上面相同的代码片段的示例，但是这次提供了ScreenUpdating和Calculation设置：

 Public Sub toLowerCase() Dim lr As Integer Application.ScreenUpdating = False Application.Calculation = xlCalculationManual For lr = 1 To Application.ActiveSheet.UsedRange.Rows.Count Application.ActiveSheet.Cells(lr, 1) = LCase(Application.ActiveSheet.Cells(lr, 1).Value) Next lr Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True End Sub 

Answer 5

你可以做到这一点没有循环，没有工作列

1. 将范围（单行或列）转储到一维string数组中
2. 取下string的小写字母并将其转储回范围

码

 Sub NoLoops() Dim rng1 As Range Dim strOut As String Dim strDelim As String strDelim = "," Set rng1 = Range([a1], Cells(Rows.Count, "A").End(xlUp)) X = LCase$(Join(Application.Transpose(rng1), strDelim)) rng1 = Application.Transpose(Split(X, strDelim)) End Sub 

更短的版本

 Sub OneLine() Range([a1], Cells(Rows.Count, "A").End(xlUp)) = Application.Transpose(Split(LCase$(Join(Application.Transpose(Range([a1], Cells(Rows.Count, "A").End(xlUp))), ",")), ",")) End Sub 

[Update for the 65536 cell limit with Transpose]

对于150k行，此方法确实需要将列分块为2 ^ 16个部分，因为Application Transpose的限制。 这是一个恼人的调整“无循环”成为“最小循环”

 Sub Transpose_Adjust() Dim rng1 As Range Dim rng2 As Range Dim lngCnt As Long Dim lngLim As Long Dim lngCalac As Long Dim strOut As String Dim strDelim As String With Application .ScreenUpdating = False .EnableEvents = False lngCalc = .Calculation .Calculation = xlCalculationManual End With strDelim = "," Set rng1 = Range([a1], Cells(Rows.Count, "A").End(xlUp)) 'TRANSPOSE limited to 65536 cells lngLim = Application.Min(16, Int(rng1.Cells.Count / 2 ^ 16)) For lngCnt = 1 To lngLim Set rng2 = rng1.Cells(1).Offset((lngCnt - 1) * 2 ^ 16, 0).Resize(2 ^ 16, 1) X = LCase$(Join(Application.TransPose(rng2), strDelim)) rng2.Value2 = Application.TransPose(Split(X, strDelim)) Next lngCnt With Application .ScreenUpdating = True .EnableEvents = True Calculation = lngCalc End With End Sub