मैं कुछ सबरूटीन्स बना दिया है और वे 5 फाइलों पर परीक्षण चरण में महान काम किया, लेकिन जब मैं उन्हें वास्तविक आंकड़ों पर काम करने के लिए रखा है, कि 600 फ़ाइलें है, कुछ समय के बाद मैं यह संदेश प्राप्त:मेमोरी कमी एक्सेल VBA
एक्सेल उपलब्ध संसाधनों के साथ इस कार्य को पूरा नहीं कर सकते। कम डेटा चुनें या अन्य अनुप्रयोगों को बंद करें।
मैं इसे googled है और सबसे मैंने पाया application.cutcopymode = false
था, लेकिन मेरे कोड में मैं कटौती का उपयोग कर रहा है और मोड कॉपी, लेकिन
destrange.Value = sourceRange.Value
साथ कॉपी करने संभाल और जब मैं डिबग करने के लिए जाना , मेरा मतलब है त्रुटि संकेत के बाद यह मुझे कोड की एक ही पंक्ति में ले जाता है। अगर कोई ऐसी ही स्थिति का सामना करना पड़ा, और कैसे समस्या मैं आभारी होंगे हल करने के लिए जानता है गया है।
बस अपने आप को स्पष्ट करना मैं application.cutcopymode = false
की कोशिश की है और यह मदद नहीं की। मैं इस 600 फाइलों में से प्रत्येक खोलने रहा हूँ, तरह विभिन्न मानदंड के अनुसार और प्रत्येक से नई कार्यपुस्तिका (एक के बाद एक) में कॉपी पहले 100 और मैं बचाने जब मैं एक मापदंड के साथ खत्म हो और करीब है कि नई कार्यपुस्तिका और नए खोलने के लिए और से डेटा निकालने के लिए जारी विभिन्न मानदंड
किसी की मदद करने के लिए मैं भी कोड प्रदान कर सकते हैं, लेकिन सवाल सरल मैंने नहीं किया बनाने के लिए रुचि रखते है। किसी भी मदद या सुझाव स्वागत से अधिक है। धन्यवाद।
संपादित करें:
यहाँ मुख्य उप है: (यह उद्देश्य है कि कितने कॉपी करने के लिए पहली पंक्तियों पर कार्यपुस्तिका जानकारी लेने के लिए है, क्योंकि मैं पहले 100 कॉपी करने के लिए एक बार की जरूरत है तो 50, फिर 20, तो है, 10 ...)
Sub final()
Dim i As Integer
Dim x As Integer
For i = 7 To 11
x = ThisWorkbook.Worksheets(1).Range("N" & i).Value
Maximum_sub x
Minimum_sub x
Above_Average_sub x
Below_Average_sub x
Next i
End Sub
और यहाँ यह बाद के चरणों में से एक है: (अन्य मूलतः एक ही है, बस प्रकार मापदंड परिवर्तन कर रहे हैं)
Sub Maximum_sub(n As Integer)
Dim MyPath As String, FilesInPath As String
Dim MyFiles() As String
Dim SourceRcount As Long, FNum As Long
Dim mybook As Workbook, BaseWks As Worksheet
Dim sourceRange As Range, destrange As Range
Dim rnum As Long
Dim srt As Sort
' The path\folder location of your files.
MyPath = "C:\Excel\"
' If there are no adequate files in the folder, exit.
FilesInPath = Dir(MyPath & "*.txt")
If FilesInPath = "" Then
MsgBox "No files found"
Exit Sub
End If
' Fill the myFiles array with the list of adequate files
' in the search folder.
FNum = 0
Do While FilesInPath <> ""
FNum = FNum + 1
ReDim Preserve MyFiles(1 To FNum)
MyFiles(FNum) = FilesInPath
FilesInPath = Dir()
Loop
'get a number: take a top __ from each
'n = ActiveWorkbook.Worksheets(1).Range("B4").Value
' Add a new workbook with one sheet.
Set BaseWks = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
rnum = 1
' Loop through all files in the myFiles array.
If FNum > 0 Then
For FNum = LBound(MyFiles) To UBound(MyFiles)
Set mybook = Workbooks.Open(MyPath & MyFiles(FNum))
' Change this to fit your own needs.
' Sorting
Set srt = mybook.Worksheets(1).Sort
With srt
.SortFields.Clear
.SortFields.Add Key:=Columns("C"), SortOn:=xlSortOnValues, Order:=xlDescending
.SetRange Range("A1:C18000")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'Deleting nulls
Do While (mybook.Worksheets(1).Range("C2").Value = "null")
mybook.Worksheets(1).Rows(2).Delete
Loop
Set sourceRange = mybook.Worksheets(1).Rows("2:" & n + 1)
SourceRcount = sourceRange.Rows.Count
Set destrange = BaseWks.Range("A" & rnum)
BaseWks.Cells(rnum, "A").Font.Bold = True
BaseWks.Cells(rnum, "B").Font.Bold = True
BaseWks.Cells(rnum, "C").Font.Bold = True
Set destrange = destrange.Resize(sourceRange.Rows.Count, sourceRange.Columns.Count)
destrange.Value = sourceRange.Value
rnum = rnum + SourceRcount
mybook.Close savechanges:=False
Next FNum
BaseWks.Columns.AutoFit
End If
BaseWks.SaveAs Filename:="maximum_" & CStr(n)
Activewoorkbook.Close
End Sub
प्रासंगिक कोड देखकर बेहद मददगार होगा बनाने के लिए होगा। शायद कुछ ठीक से बंद या निपटान नहीं किया जा रहा है। और इंगित करें कि कोड की कौन सी पंक्ति त्रुटि उत्पन्न कर रही है। – LittleBobbyTables
यह काफी लंबे समय से है, लेकिन मैं – balboa
@LittleBobbyTables मैं कोड प्रदान की है प्रश्न में संपादन में इसे प्रदान करने की कोशिश करेंगे। प्रयास के लिए धन्यवाद। :) – balboa