5

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

我想知道是否有更有效的方法来做到这一点 - 我的工作表中有大约 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
4

5 回答 5

6

使用电子表格来完成。我将一些数据放入，并在:$A$1:$A$384188中制作了一个数组公式。它是即时的，不会占用太多内存。$B$1:$B$384188{=UPPER($A$1:$A$384188)}

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

于 2012-08-13T13:57:42.497 回答
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。

于 2012-08-13T13:49:36.927 回答
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
于 2012-08-13T14:13:15.297 回答
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 之外，您可能还需要考虑将Calculation设置为 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
于 2012-08-13T13:54:47.740 回答
0

您可以在没有循环和工作列的情况下执行此操作

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

代码

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. 这是对“无循环”变成“最小循环”的恼人调整

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
于 2012-08-14T01:40:17.317 回答