एक्सेल में एकाधिक वर्कशीट से अद्वितीय मानों की सूची कैसे बनाएं?
क्या हमारे लिए किसी कार्यपुस्तिका में सभी कार्यपत्रकों से अद्वितीय मानों की सूची बनाने का कोई त्वरित तरीका है? उदाहरण के लिए, मेरे पास चार वर्कशीट हैं जिनमें कॉलम ए में डुप्लिकेट वाले कुछ नाम सूचीबद्ध हैं, और अब, मैं इन शीटों से सभी अद्वितीय नामों को एक नई सूची में निकालना चाहता हूं, मैं एक्सेल में यह काम कैसे पूरा कर सकता हूं?
VBA कोड के साथ एकाधिक वर्कशीट से अद्वितीय मानों की एक सूची बनाएं
VBA कोड के साथ एकाधिक वर्कशीट से अद्वितीय मानों की एक सूची बनाएं
सभी कार्यपत्रकों से सभी अद्वितीय मानों को सूचीबद्ध करने के लिए, निम्नलिखित वीबीए कोड आपकी मदद कर सकता है, कृपया ऐसा करें:
1. दबाए रखें ALT + F11 कुंजी को खोलने के लिए अनुप्रयोगों के लिए माइक्रोसॉफ्ट विज़ुअल बेसिक खिड़की.
2। क्लिक करें सम्मिलित करें > मॉड्यूल, और निम्नलिखित मैक्रो को इसमें पेस्ट करें मॉड्यूल खिड़की।
VBA कोड: एकाधिक कार्यपत्रकों से अद्वितीय मानों की एक सूची बनाएं:
Sub SheelsUniqueValues()
Dim xObjNewWS As Worksheet
Dim xObjWS As Worksheet
Dim xStrAddress As String
Dim xIntRox As Long
Dim xIntN As Long
Dim xFNum As Integer
Dim xMaxC, xColumn As Integer
Dim xR As Range
xStrName = "Unique value"
Application.ScreenUpdating = False
xMaxC = 0
Application.DisplayAlerts = False
For Each xObjWS In Sheets
If xObjWS.Name = xStrName Then
xObjWS.Delete
Exit For
End If
Next
Application.DisplayAlerts = True
For xFNum = 1 To Sheets.Count
xColumn = Sheets(xFNum).Cells.Find(What:="*", after:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
If xMaxC < xColumn Then
xMaxC = xColumn
End If
Next xFNum
Application.DisplayAlerts = True
Set xObjNewWS = Sheets.Add(after:=Sheets(Sheets.Count))
xObjNewWS.Name = xStrName
For xColumn = 1 To xMaxC
xIntN = 1
For xFNum = 1 To Sheets.Count - 1
Set xR = Sheets(xFNum).Columns(xColumn)
If TypeName(Sheets(xFNum).Columns(xColumn).Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious)) <> "Nothing" Then
xIntRox = xR.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Sheets(xFNum).Range(Cells(1, xColumn).Address & ":" & Cells(xIntRox, xColumn).Address).Copy
Cells(xIntN, xColumn).PasteSpecial xlValues
xIntN = xIntRox + xIntN + 1
End If
Next xFNum
If xIntRox - 1 > 0 Then
xIntRox = xIntN - 1
xStrAddress = Cells(1, xColumn).Address & ":" & Cells(xIntRox, xColumn).Address
Range(xStrAddress).AdvancedFilter Action:=xlFilterInPlace, Unique:=True
Range(xStrAddress).Copy
Cells(1, xColumn + 1).PasteSpecial xlValues
Range(xStrAddress).AdvancedFilter Action:=xlFilterInPlace, Unique:=False
Columns(xColumn).Delete
Range(xStrAddress).Sort key1:=Cells(1, xColumn), Header:=xlNo
End If
Next xColumn
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
3. उपरोक्त कोड को पेस्ट करने के बाद दबाएँ F5 इस कोड को चलाने के लिए, और एक नई वर्कशीट नाम दें अद्वितीय मूल्य बनाया गया है और सभी शीटों से कॉलम ए में अद्वितीय नाम दिखाए गए स्क्रीनशॉट के अनुसार सूचीबद्ध हैं:
सर्वोत्तम कार्यालय उत्पादकता उपकरण
एक्सेल के लिए कुटूल के साथ अपने एक्सेल कौशल को सुपरचार्ज करें, और पहले जैसी दक्षता का अनुभव करें। एक्सेल के लिए कुटूल उत्पादकता बढ़ाने और समय बचाने के लिए 300 से अधिक उन्नत सुविधाएँ प्रदान करता है। वह सुविधा प्राप्त करने के लिए यहां क्लिक करें जिसकी आपको सबसे अधिक आवश्यकता है...
ऑफिस टैब ऑफिस में टैब्ड इंटरफ़ेस लाता है, और आपके काम को बहुत आसान बनाता है
- Word, Excel, PowerPoint में टैब्ड संपादन और रीडिंग सक्षम करें, प्रकाशक, एक्सेस, विसियो और प्रोजेक्ट।
- नई विंडो के बजाय एक ही विंडो के नए टैब में एकाधिक दस्तावेज़ खोलें और बनाएं।
- आपकी उत्पादकता 50% बढ़ जाती है, और आपके लिए हर दिन सैकड़ों माउस क्लिक कम हो जाते हैं!
