现在我使用下面的代码将整个列更改为小写。
我想知道是否有更有效的方法来实现这一点 - 我的工作表中有大约150K行。
完成需要一些时间，有时我会收到Out of Memory错误。
First Sub
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
Second 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
答案 0 :(得分：6)
使用电子表格执行此操作。我在$A$1:$A$384188中添加了一些数据，并在$B$1:$B$384188中创建了一个数组公式：{=UPPER($A$1:$A$384188)}。这是立即的，并没有使用太多的记忆。
通过VBA循环将总是慢得多，内存密集。 您可以使用VBA创建公式，并按值复制粘贴数据。
答案 1 :(得分：3)
您有时会收到错误，因为您尝试将多少内容打包到数组中。您放入该阵列的所有内容都必须符合您的可用内存。
这样的事情应该更好（注意这是未经测试的代码）：
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常量来在速度和内存使用之间找到一个很好的平衡。
您还需要添加错误处理程序，以确保在出现问题时重新启用ScreenUpdating。
答案 2 :(得分：3)
看起来有一些冗余，绝对是阵列的问题。
我认为你可以删除Lowercasing（）函数并增强Concatenating来为你做小写：
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
答案 3 :(得分：1)
这是另一种降低列中每个单元格的方法，也许值得一试：
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
不是创建数组并重置范围，而是简单地使用UsedRange并按原样设置值。这避免了对数组的需求，这在处理这种大小的数据时可能会出现问题。
仅供参考...我注意到你在代码片段中进行了复制。如果你正在复制大量的单元格，那么设置每个单元格值（例如cellTarget.Value = cellSource.Value）比将一个单元格值复制到另一个单元格值更快更多。
另外，我注意到您将 ScreenUpdating 设置为False ...您在哪里将其设置为True？除了在这些大型计算期间切换ScreenUpdating之外，您可能还需要考虑setting Calculation to manual。有时当工作表得到这么多活动时，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
答案 4 :(得分：0)
您可以在没有循环且没有工作列的情况下执行此操作
码
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行，在Application Transpose给定限制的情况下，此方法需要 chunk 该列为2 ^ 16个部分。这是对“无循环”变成“最小循环”的烦人调整
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