मुझे कॉलम के प्रत्येक अद्वितीय मान के लिए एक टेबल बनाने की आवश्यकता है। मैंने प्रत्येक फ़िल्टर का चयन करने के लिए ऑटोफ़िल्टर का उपयोग किया और फिर दूसरी शीट पर कॉपी और पेस्ट किया। डेटा की मात्रा (बड़े) के कारण मैं स्वचालित करना चाहता हूं और शायद प्रत्येक चक्र के लिए ऐसा करता हूं जहां प्रत्येक फ़िल्टर व्यक्तिगत रूप से चुना जाता है और एक अलग शीट पर कॉपी किया जाता है। क्या यह संभव भी है? क्या कोई जानता है कि इस समस्या को सरल कैसे बनाया जा सकता है?

0
Catia Saraiva 10 मई 2021, 20:00
1
क्या आपने Remove duplicate फ़ंक्शन का प्रयास किया? support.microsoft. com/en-us/office/… (Remove duplicate values अनुभाग)
 – 
Алексей Р
10 मई 2021, 20:12
विश्लेषण के लिए डुप्लीकेट रखना महत्वपूर्ण है ... हालांकि मैं कॉलम में वस्तुओं पर विचार करते हुए अपनी तालिका को अलग-अलग तालिकाओं में विभाजित करना चाहता हूं
 – 
Catia Saraiva
11 मई 2021, 13:05
1) संपूर्ण मूल तालिका को एक नई शीट में कॉपी करें। 2) नई शीट पर डुप्लिकेट हटाएं। 3) जिससे अद्वितीय मूल्यों के साथ एक तालिका प्राप्त हो रही है। क्या यह तर्क काम करता है?
 – 
Алексей Р
11 मई 2021, 13:16

1 उत्तर

सबसे बढ़िया उत्तर
Option Explicit

Sub CreateTables()

    Const COL_FILTER = 1 ' A
    Const SHT_NAME = "Sheet1" ' data sheet

    Dim wb As Workbook, ws As Worksheet
    Dim rng As Range, iLastRow As Long, i As Long

    Set wb = ThisWorkbook
    Set ws = wb.Sheets(SHT_NAME)

    ' get list as unique values
    Dim dict, key, ar
    Set dict = CreateObject("Scripting.Dictionary")

    iLastRow = ws.Cells(Rows.Count, COL_FILTER).End(xlUp).Row
    ar = ws.Cells(1, COL_FILTER).Resize(iLastRow, 1)
    For i = 2 To iLastRow
        dict(ar(i, 1)) = 1
    Next

    ' confirm
    If MsgBox(dict.Count & " sheets will be created," & _
              " continue ? ", vbYesNo) = vbNo Then
        Exit Sub
    End If

    ' apply autofilter in turn
    ' copy to new sheet
    Set rng = ws.UsedRange
    ws.AutoFilterMode = False
    For Each key In dict
        With wb.Sheets.Add(After:=wb.Sheets(wb.Sheets.Count))
            .Name = CStr(key)
            rng.AutoFilter COL_FILTER, CStr(key)
            rng.SpecialCells(xlCellTypeVisible).Copy .Range("A1")
            .ListObjects.Add(xlSrcRange, .UsedRange, , xlYes) _
                .Name = "Table " & key
        End With
        MsgBox "Created sheet " & key
    Next
    
    MsgBox dict.Count & " sheets created"
End Sub
0
CDP1802 11 मई 2021, 19:32
ठीक यही मैं ढूंढ रहा था !!! आपका बहुत बहुत धन्यवाद ! मेरे पास बस एक और सवाल है, कुछ मानों में अमान्य वर्ण हैं जैसे \ और º इस समस्या के आसपास काम करने का कोई तरीका है? एक बार फिर आप सभी को आपके समय और मदद के लिए धन्यवाद!
 – 
Catia Saraiva
12 मई 2021, 13:46
क्या वे मूल डेटा या प्रतियों में हैं? आप उन्हें एक स्थान से क्या बदलना चाहते हैं? एक श्रेणी विधि है प्रतिस्थापित करें
 – 
CDP1802
12 मई 2021, 14:33
नमस्ते! डेटा को पीडीएफ से एक्सेल में बदल दिया गया था, इसलिए समस्या हो सकती है। हालांकि, मैंने सुझाव को बदलने के आपके तरीके का पालन किया है और यह ठीक काम करता है! आपका बहुत बहुत धन्यवाद
 – 
Catia Saraiva
12 मई 2021, 16:40