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. 範囲 (単一の行または列) を 1D 文字列配列にダンプします
  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]

150,000 行の場合、このメソッドは、制限を考慮して、列を 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
于 2012-08-14T01:40:17.317 に答える