आपकी टिप्पणियों से मुझे लगता है कि आपने कभी VBA मैक्रो नहीं लिखा है। आपकी पहली मैक्रो एक कठिन चढ़ाई होगी लेकिन उसके बाद हर एक आसान हो जाएगा जब तक आप भूल जाते हैं कि आपने कभी नहीं सोचा था कि उन्हें लिखना मुश्किल हो सकता है।
नीचे मैक्रो मानता है कि सभी 2,500 वर्कबुक एक ही फ़ोल्डर में हैं। यह आमतौर पर सबसे आसान तरीका है लेकिन यह आपके मामले में संभव नहीं हो सकता है। यदि यह संभव नहीं है, तो इस मैक्रो को आज़माने के लिए बहुत सारी वर्कबुक के साथ एक फ़ोल्डर चुनें। आपको अपने प्रश्न के लिए अपनी स्थिति का स्पष्टीकरण जोड़ना होगा ताकि मैं समझा सकूं कि इस मैक्रो को कैसे संबोधित किया जा सकता है।
मैंने चीजों को सरल रखने की कोशिश की है, हालांकि ऐसा नहीं लग सकता है। एक ही काम करने के बेहतर, तेज तरीके हैं लेकिन मुझे लगता है कि यह सही समझौता है। मैंने बहुत सारी टिप्पणियों को यह बताते हुए शामिल किया है कि कोड क्या करता है। मैक्रो एडिटर की मदद सिंटैक्स की व्याख्या करेगी। लेकिन पूछें कि क्या आप संघर्ष कर रहे हैं।
परीक्षण के लिए आपके द्वारा चुने गए फ़ोल्डर में एक नई कार्यपुस्तिका बनाएं। मेरा कोड "बोबार्ट" नामक एक वर्कशीट की उम्मीद करता है जो मेरे लिए सुविधाजनक है। एक ऐसा नाम चुनें जो आपके लिए समझ में आता है और कोड को मैच के लिए बदल देता है; मैं आपको बाद में बताता हूं।
का चयन करें Toolsतो Macroतो Visual Basic Editorया क्लिक Alt+ F11।
नीचे बाईं ओर आपके पास प्रोजेक्ट एक्सप्लोरर होगा। दाईं ओर शीर्ष पर आपके पास एक ग्रे क्षेत्र होगा। दाईं ओर सबसे नीचे आपको तत्काल विंडो होगी। मैं तत्काल खिड़की के बारे में बाद में बात कर सकता हूं।
Insertउसके बाद सेलेक्ट करें Module। "मॉड्यूल 1" प्रोजेक्ट एक्सप्लोरर में जोड़ा जाएगा और ग्रे क्षेत्र सफेद हो जाता है। यह मॉड्यूल 1 का कोड क्षेत्र है।
आप मॉड्यूल नाम को "मॉड्यूल 1" के रूप में छोड़ सकते हैं या इसे बदल सकते हैं। F4 पर क्लिक करें। गुण विंडो प्रदर्शित करेगा। एक मॉड्यूल के लिए एकमात्र संपत्ति इसका नाम है। "मॉड्यूल 1" में "(नाम) मॉड्यूल 1" पर क्लिक करें, "मॉड्यूल 1" को बैकस्पेस दें और अपनी पसंद के नाम पर टाइप करें। गुण विंडो बंद करें।
कोड क्षेत्र के नीचे कोड कॉपी करें।
यह मैक्रो आपकी समस्या के पहले भाग से निपटता है: यह फ़ोल्डर में सभी कार्यपुस्तिकाओं और उन कार्यपुस्तिकाओं के भीतर सभी वर्कशीट पाता है। यह वर्कशीट "बोबार्ट" में उन वर्कशीट की सूची बनाता है। यदि 2,500 कार्यपुस्तिकाओं को एक एकल फ़ोल्डर में एक साथ नहीं लाया जा सकता है, तो आपको कार्यपुस्तिकाओं और कार्यपत्रकों की सूची बनाने के लिए इस तरह के मैक्रो की आवश्यकता हो सकती है, लेकिन इस मैक्रो को प्रशिक्षण अभ्यास के रूप में अभिप्रेत है। हेडर लाइन बनाएं:
A1 = Folder
B1 = Workbook
C1 = Worksheet
आपको तुरंत बदलने के लिए केवल एक बयान की आवश्यकता होगी:
Set WShtDest = ActiveWorkbook.Worksheets("Bobert")
कार्यपत्रक के लिए आपके द्वारा चुने गए नाम में "बोबार्ट" बदलें जिसमें कार्यपत्रकों की सूची बनाई जाएगी।
कथन पर कर्सर रखें:
RowDestCrnt = .Cells(Rows.Count, "A").End(xlUp).Row + 1
और F9 पर क्लिक करें। रेखा भूरी हो जाएगी क्योंकि आपने इसे एक विराम बिंदु बनाया है जिसे मैं एक पल में समझाता हूं।
हर बार जब आप F8 पर क्लिक करते हैं, तो कोड के एक कथन का पालन किया जाएगा। यह आपको कोड के माध्यम से कदम रखने की अनुमति देता है। यदि आप कर्सर को एक चर नाम पर रखते हैं, तो इसका मूल्य प्रदर्शित किया जाएगा। आप क्या बदल गया है यह जांचने के लिए आप वर्कशीट पर जा सकते हैं।
यदि आपको लगता है कि आप कोड के ब्लॉक को समझते हैं, तो F5 पर क्लिक करें और कोड अगले ब्रेकपॉइंट तक चलेगा। मैंने एक सेट किया है लेकिन आप जितना चाहें सेट कर सकते हैं।
मुझे उम्मीद है कि इससे आपको कुछ सोचने को मिलेगा। मेरे सवालों का जवाब दें और मैं आपको समाधान का अगला हिस्सा दे सकता हूं।
Option Explicit
' Searching for content in a large number of Excel files
' http://superuser.com/q/452980/108084
Sub ListWorksheets()
Dim ColDestCrnt As Long
Dim FileNameList() As String
Dim InxFNL As Long
Dim InxW As Long
Dim PathCrnt As String
Dim RowDestCrnt As Long
Dim WBkSource As Workbook
Dim WShtDest As Worksheet
Application.ScreenUpdating = False
' Create a reference to the worksheet in which data will be stored
' Change "Bobert" to your name for the destination worksheet.
Set WShtDest = ActiveWorkbook.Worksheets("Bobert")
' This assumes the source workbooks are in the same folder as the workbook
' holding this macro. You could replace this with a statement like:
' PathCrnt = "C:\MyFiles"
PathCrnt = ActiveWorkbook.Path
' GetFileNameList is a subroutine I wrote sometime ago. It returns an
' array of filenames within a specified folder (PathCrnt) that match a
' specified format (*.xls).
Call GetFileNameList(PathCrnt, "*.xls", FileNameList)
' Get the next free row in worksheet Bobert. By calling this routine with
' different values for PathCrnt, you could built up a list containing files
' from many folders.
With WShtDest
RowDestCrnt = .Cells(Rows.Count, "A").End(xlUp).Row + 1
End With
For InxFNL = LBound(FileNameList) To UBound(FileNameList)
If FileNameList(InxFNL) <> ActiveWorkbook.Name Then
' In the Workbook Open statement, 0 means "do not update any links" and
' True means "open read only"
Set WBkSource = Workbooks.Open(PathCrnt & "\" & FileNameList(InxFNL), 0, True)
With WBkSource
' Record the name of each worksheet in the workbook
For InxW = 1 To .Worksheets.Count
WShtDest.Cells(RowDestCrnt, "A").Value = PathCrnt
WShtDest.Cells(RowDestCrnt, "B").Value = FileNameList(InxFNL)
WShtDest.Cells(RowDestCrnt, "C").Value = .Worksheets(InxW).Name
RowDestCrnt = RowDestCrnt + 1
Next
.Close SaveChanges:=False ' Close this source workbook
End With
End If
Next
End Sub
Sub GetFileNameList(ByVal PathCrnt As String, ByVal FileSpec As String, _
ByRef FileNameList() As String)
' This routine sets FileNameList to the names of files within folder
' PathCrnt that match FileSpec. It uses function Dir$() to get the file names.
' I can find no documentation that says Dir$() gets file names in alphabetic
' order but I have not seen a different sequence in recent years.
Dim AttCrnt As Long
Dim FileNameCrnt As String
Dim InxFNLCrnt As Long
' I initialise the array with space for 100 files and then enlarge it if
' necessary. This is normally enough space for my applications but since
' you are expecting 2,500 files I have replaced the original statement.
'ReDim FileNameList(1 To 100)
ReDim FileNameList(1 To 2500)
InxFNLCrnt = 0
' Ensure path name ends in a "\"
If Right(PathCrnt, 1) <> "\" Then
PathCrnt = PathCrnt & "\"
End If
' This Dir$ returns the name of the first file in
' folder PathCrnt that matches FileSpec.
FileNameCrnt = Dir$(PathCrnt & FileSpec)
Do While FileNameCrnt <> ""
' "Files" have attributes, for example: normal, to-be-archived, system,
' hidden, directory and label. It is unlikely that any directory will
' have an extension of XLS but it is not forbidden. More importantly,
' if the files have more than one extension so you have to use "*.*"
' instead of *.xls", Dir$ will return the names of directories. Labels
' can only appear in route directories and I have not bothered to test
' for them
AttCrnt = GetAttr(PathCrnt & FileNameCrnt)
If (AttCrnt And vbDirectory) <> 0 Then
' This "file" is a directory. Ignore
Else
' This "file" is a file
InxFNLCrnt = InxFNLCrnt + 1
If InxFNLCrnt > UBound(FileNameList) Then
' There is a lot of system activity behind "Redim Preserve". I reduce
' the number of Redim Preserves by adding new entries in chunks and
' using InxFNLCrnt to identify the next free entry.
ReDim Preserve FileNameList(1 To 100 + UBound(FileNameList))
End If
FileNameList(InxFNLCrnt) = FileNameCrnt
End If
' This Dir$ returns the name of the next file that matches
' the criteria specified in the initial call.
FileNameCrnt = Dir$
Loop
' Discard the unused entries
ReDim Preserve FileNameList(1 To InxFNLCrnt)
End Sub