एक्सेल - खोज और कॉपी करने के लिए मैक्रो बनाना

मुद्दा

मेरे पास इसकी पंक्ति में संबंधित डेटा के साथ सभी अलग-अलग तिथियों के साथ एक स्प्रेडशीट है। एक ही तिथि के साथ कई पंक्तियाँ हैं और मैं सभी तिथियों की खोज करने के लिए एक मैक्रो बनाना चाहता हूं और उन्हें शीट 2 में कॉपी और पेस्ट करना चाहता हूं ताकि मैं उन्हें क्रम में रख सकूं

उदाहरण:

 २-सिपाही २--सिपाही २ Sep-सिपाही २ Sep-सिपाही २ Sep-सिपाही ०१-अक्टूबर ०१-अक्टूबर

मुझे पता नहीं है कि मैक्रो कैसे बनाया जाता है, हालांकि मैंने एक खोजने के लिए पूरे इंटरनेट पर खोज की है कि मैं अपना खुद का डेटा सम्मिलित करने के लिए संशोधित कर सकता हूं, और यह वही है जो ive के साथ आता है।

 उप SearchForString () डिम LSearchRow इन्टर्गर के रूप में Dim LCopyToRow इन्टर्गर ऑन एरर GoTo Err_Execute 'पंक्ति में खोज शुरू करें 6 LSearchRow = 6' शीट में डेटा 110 (पंक्ति काउंटर वेरिएबल) LCopyToRow = 110 पर लेन ("A" के लिए डेटा कॉपी करना शुरू करें) & CStr (LSearchRow))। मान)> 0 'यदि स्तंभ A = "27-Sep" में मान है, तो पूरी पंक्ति को Sheet2 यदि "रेंज" ("A" और CStr (LSearchRow)) पर कॉपी करें। मान = "27" सिपाही 'Rows (CStr (LSearchRow)) और कॉपी करने के लिए Sheet1 में पंक्ति का चयन करें: "और CStr (LSearchRow)) चयन करें। चयन करें। अगली पंक्ति में शीट 2 में शीट को चिपकाएं (" Sheet2 ") पंक्तियों (CStr (LCopyToRow) का चयन करें। & ":" और CStr (LCopyToRow)) का चयन करें ActiveSheet.Paste 'अगली पंक्ति पर जाएं। LCopyToRow = LCopyToRow + 1' शीट पर वापस जाएं शीट खोजने के लिए जारी रखें ("Sheet1")। अंत का चयन करें यदि LSearchRow = LSearchRow + 1 Wend चुनें। 'सेल A109 पर स्थिति। ApplicationCCopyMode = झूठी श्रेणी ("A109")। MsgBox का चयन करें "सभी मिलान किए गए डेटा की प्रतिलिपि बनाई गई है।" सब एर्र_एक्स्यूट से बाहर निकलें: MsgBox "एक त्रुटि हुई।" अंत उप

उपाय

मैं दो मैक्रोज़ "टेस्ट" और "पूर्ववत" दे रहा हूं

सैंपल शीट इस तरह है (sheet1) -आर्ट करने के लिए जरूरी नहीं है

डेट 1 डेटा 2

3/1/2010 37 1

3/2/2010 65 96

3/3/2010 48 46

3/2/2010 78 54

3/5/2010 3 38

3/2/2010 83 58

3/3/2010 45 78

मैक्रो "परीक्षण" का प्रयास करें और शीट 2 देखें

यदि आप चाहते हैं

1. "पूर्ववत करें"

फिर

2. "परीक्षण"

मैक्रों हैं

 सब टेस्ट () डिम आर ऐज रेंज, आर १ अस रेंज, आर २ अस रेंज डिम सी २ अस रेंज, सीडेन अस रेंज वर्क्सशीट ("शीट १")। एक्टिवेट सेट आर = रेंज (रेंज ("ए 1"), रेंज ("ए 1")। .End (xlDown)) r1 = Range ("a1") सेट करें। अंत (xlDown) ।Offset (5, 0) r.AdvancedFilter एक्शन: = xlFilterCopy, copytorange: = r1, unique: = True Set r2 = Range (r1) .Offset (1, 0), r1.End (xlDown)) प्रत्येक c2 के लिए r2 में WorksheetFunction.CountIf (r, c2)> 1 फिर रेंज के साथ ("A1")। CurrentRegion .AutoFilter फ़ील्ड: = 1, Criteria1: = c2.Value .Cells.SpecialCells (xlCellTypeV अदृश्य) .Copy Worksheets ("sheet2")। कक्ष (पंक्तियाँ, "A")। End (xlcp) .Offset (1, 0) .PasteSpecial अंत के साथ यदि ActiveSheet है। AutoFilterMode = गलत अगला c2 कार्यपत्रक ("शीट 2")। सक्रिय करें सेट करें cfind = ActiveSheet.Cells.Find (क्या: = "तिथि", लुक: = xlWhole, के बाद: रेंज ("A2")) यदि cfind कुछ भी नहीं है तो Exit Do cfind.EntireRow.Delete Loop Worksheets ("sheet1")। Range ("A1")। EntireRow.Copy Worksheets ("sheet2")। Range ("A1")। PasteSpecial Application.CutCopyMode = False End Sub Sub undo () ) वर्कशीट ("शीट 2")। कोशिकाएं। क्लियर एंड सब