Excel VBA中的高效下壳体

Question

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

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

使用电子表格执行此操作.我在把一些数据$A$1:$A$384188,并在由阵列式$B$1:$B$384188:{=UPPER($A$1:$A$384188)}.这是立即的,并没有使用太多的内存.

通过VBA循环将总是慢得多,内存密集.您可以使用VBA创建公式并按值复制粘贴数据.

Answer 2

看起来有一点冗余，并且阵列肯定有问题。

我认为您可以删除 Lowercasing() 函数并增强 Concatenation 来为您执行小写操作：

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