एक्सेल वीबीए

Question

में कुशल लोअर केसिंग अभी मैं एक संपूर्ण कॉलम को कम मामले में बदलने के लिए नीचे दिए गए कोड का उपयोग करता हूं।

मैं सोच रहा था कि ऐसा करने का एक और अधिक प्रभावी तरीका है - मेरे पास वर्कशीट में लगभग 150 के पंक्तियां हैं।

इसे पूरा करने में कुछ समय लगता है और कभी-कभी मुझे 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

ऐसा लगता है कि थोड़ा सा अनावश्यकता है और निश्चित रूप से सरणी के साथ एक समस्या है।

मुझे लगता है कि आप Lowercasing() फ़ंक्शन को हटा दें और आप के लिए 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

आप क्योंकि आप कितना सामान एक सरणी में पैक करने के लिए कोशिश कर रहे हैं कभी कभी त्रुटि हो रही है। उस सरणी में जो कुछ भी आपने डाला है वह आपकी उपलब्ध स्मृति के अंदर फिट होना चाहिए।

कुछ इस तरह बेहतर काम करना चाहिए (ध्यान दें कि यह अपरीक्षित कोड है):

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 निरंतर के साथ खेल सकते हैं।

आप यह सुनिश्चित करने के लिए एक त्रुटि हैंडलर भी जोड़ना चाहेंगे कि समस्याओं के मामले में स्क्रीन अपडेटिंग वापस चालू हो जाए।

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 उपयोग करता है और मूल्य निर्धारित करता है के रूप में यह हो जाता है के बजाय:

Answer 3

यहाँ एक स्तंभ में प्रत्येक कक्ष lowercasing लिए एक और तरीका है, शायद यह एक शॉट के लायक है । यह सरणी की आवश्यकता से बचाता है, जो इस आकार के डेटा के साथ गड़बड़ करते समय समस्याग्रस्त हो सकता है।

FYI ... मैंने आपके कोड स्निपेट में प्रतिलिपि बनाई है जो आप कॉपी करते हैं। यदि आप बड़ी मात्रा में कोशिकाओं पर प्रतिलिपि बना रहे हैं, तो यह प्रत्येक सेल मान (उदा। cellTarget.Value = cellSource.Value) सेट करने के लिए अधिक तेज है, यह एक सेल मान को दूसरे में कॉपी करना है।

इसके अलावा, मुझे लगता है कि आप स्क्रीन अपडेटिंग गलत पर सेट करें ... आप इसे सही पर कहां सेट करते हैं? इन बड़ी गणनाओं के दौरान स्क्रीन अपडेटिंग को टॉगल करने के अलावा, आप setting Calculation to manual के बारे में सोचना चाह सकते हैं। कभी-कभी जब वर्कशीट्स को यह अधिक गतिविधि मिलती है तो Excel अक्सर गणना करेगा। इसे मनुल में सेट करके, आप ओवरहेड से बचते हैं।

यहाँ उपरोक्त कोड का एक ही स्निपेट का उपयोग कर एक उदाहरण है, लेकिन ScreenUpdating और गणना सेटिंग्स के साथ इस समय उपलब्ध कराई गई:

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 4

यह करने के लिए स्प्रेडशीट का उपयोग करें। मैंने $A$1:$A$384188 में कुछ डेटा डाला, और $B$1:$B$384188: {=UPPER($A$1:$A$384188)} में एक सरणी सूत्र बनाया। यह तत्काल है और बहुत मेमोरी का उपयोग नहीं करता है।

वीबीए के माध्यम से लूपिंग हमेशा बहुत धीमी और अधिक स्मृति गहन होगी। आप फॉर्मूला बनाने के लिए वीबीए का उपयोग कर सकते हैं और डेटा को मूल्य से वापस पेस्ट कर सकते हैं।

Answer 5

आप छोरों के बिना और काम स्तंभों के बिना

1. रेंज डंप ऐसा कर सकते हैं (एकल पंक्ति या स्तंभ) 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 पंक्तियों के लिए इस विधि हिस्सा 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