1 सवाल: किसी सूची को वर्णानुक्रम में और लंबाई के आधार पर कैसे छाँटा जाए

पर बनाया गया सवाल Tue, Apr 9, 2019 12:00 AM

मेरे पास एक सूची है जिसे मैं अल्फ़ान्यूमेरिक रूप से क्रमबद्ध करना चाहूंगा। मेरे पास वर्तमान में है मेरी सूची की तरह:

Column B    Column C    
LC-94774    102-A    
LC-94774    102-AA    
LC-94774    102-AF    
LC-94774    102-AG    
LC-94774    102-AP    
LC-94774    102-T    
LC-94774    104-M    
LC-94774    105-AA    
LC-94774    105-C    
LC-94774    105-L    
LC-94773    1    
LC-94773    2    
LC-94773    3    
LC-94773    2A

लेकिन मैं इसे अपनी ओर करने की कोशिश कर रहा हूं:

Column B        Column C    
LC-94774    102-A    
LC-94774    102-T    
LC-94774    102-AA    
LC-94774    102-AF    
LC-94774    102-AG    
LC-94774    102-AP    
LC-94774    104-M    
LC-94774    105-C    
LC-94774    105-L    
LC-94774    105-AA    
LC-94773    1    
LC-94773    2    
LC-94773    2A    
LC-94773    3

वर्तमान में, मेरे पास निम्नलिखित लिखित कोड है:

Option Explicit
Sub telecomsorter()

Dim lastRow As Long
Dim First As Long
Dim Last As Long
Dim r As Long

With Worksheets("TELECOM")

lastRow = .Cells(Rows.Count, "B").End(xlUp).Row
Range("B13:C" & lastRow).Select

ActiveWorkbook.Worksheets("TELECOM").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("TELECOM").Sort.SortFields.Add Key:=Range( _
        "B14:B" & lastRow & ""), SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _
        "BMC-*,CSR-*,MC-*,LC-*," & Chr(42) & "", DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("TELECOM").Sort.SortFields.Add2 Key:=Range( _
        "C14:C" & lastRow & ""), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal

  With ActiveSheet.Sort
      .SetRange Range("B14:C" & lastRow)
      .Header = xlNo
      .Orientation = xlTopToBottom
      .Apply
  End With

 Call SortSpecial("LC-*", xlDescending)
 Call SortSpecial("MC-*", xlAscending)
 Call SortSpecial("LC-*", xlAscending)
 Call SortSpecial("LC-*", xlDescending)
End With




End Sub

Public Function SortSpecial(ByVal StrVal As String, ByVal SortOrder As XlSortOrder)

  Dim First As Long
  Dim Last As Long

  First = Columns("B").Find(StrVal, , xlValues, , xlRows, xlNext, , , False).Row
  Last = Columns("B").Find(StrVal, , xlValues, , xlRows, xlPrevious, , , False).Row

  ActiveSheet.Sort.SortFields.Clear
  ActiveSheet.Sort.SortFields.Add Key:=Range("B" & First & ":B" & Last), SortOn:=xlSortOnValues, Order:=SortOrder, DataOption:=xlSortNormal

  With ActiveSheet.Sort

  If SortOrder = xlAscending Then
    .SetRange Range("B" & First & ":C" & Last)
  Else
  Last = ActiveSheet.Cells(Rows.Count, "B").End(xlUp).Row
  .SetRange Range("B" & First & ":C" & Last)
  End If

    .Header = xlNo
    .Orientation = xlTopToBottom
    .Apply

  End With

End Function

NEW EDIT: नहीं, इसका सिर्फ इतना है कि मैं कॉलम बी को पहले सॉर्ट करना चाहता हूं, फिर कॉलम सी के लिए, इस तरह से टाइप करें:

LC-94774 102-A

LC-94774 102-B

LC-94774 102-AA

ध्यान दें कि यह किस प्रकार सॉर्ट नहीं किया गया है: (यह है कि वर्तमान में कैसे सॉर्ट किया गया है)

LC-94774 102-A

LC-94774 102-AA

LC-94774 102-B

ध्यान दें कि यह पहले A के शीर्ष पर कैसे स्थित है, फिर B का अगला भाग है। मैं चाहता हूं कि यह पहले वर्णमाला के एकल अक्षरों में जाए, फिर AA AB AC..etc (जैसे कि स्तंभों में एमएस एक्सेल कैसे स्थापित किया जाता है)

NEW EDIT 04/09/2019:

Option Explicit
Sub sortAlphaNum()
    Dim ws As Worksheet, r As Range
    Dim wsSort As Worksheet
    Dim vSrc As Variant, vToSort As Variant
    Dim RE As Object, MC As Object
    Const sPat As String = "(\d+)-?(\D*)" 'note that some do not have a hyphen
    Dim I As Long, V As Variant
    Dim LCstartrow As Integer
    Dim LCendrow As Integer
    Dim J As Long

'input data to variant array
Set ws = Worksheets("TELECOM")

'Finding the row in which the first LC-* Drawing starts

Dim xRow As Integer
Dim strSearch As String

strSearch = "LC-*" 'Find the first
' Assuming Total is in column C as your picture shows, but you can configure to search anywhere

xRow = Range("C" & Rows.Count).End(xlUp).Row
Range("$C1:C" & xRow).Select

J = Selection.Find(What:=strSearch, After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Select

With ws
    vSrc = .Range(ActiveCell, .Cells(.Rows.Count, 2).End(xlUp)).Resize(columnsize:=2)
End With

'create array of ColB, and Col C split into Numeric, Alpha & len(alpha) for column c
'cannot split column 2 on the hyphen since not all requiring a split contain a hyphen.

ReDim vToSort(1 To UBound(vSrc, 1), 1 To 7)

Set RE = CreateObject("vbscript.regexp")
With RE
    .Global = False
    .ignorecase = False 'or could be true
    .Pattern = sPat
End With
For I = 1 To UBound(vSrc, 1)
    Set MC = RE.Execute(vSrc(I, 2))
        vToSort(I, 1) = vSrc(I, 1)
            V = Split(vSrc(I, 1), "-")
        vToSort(I, 2) = V(0)
        vToSort(I, 3) = V(1)
    Set MC = RE.Execute(vSrc(I, 2))
        vToSort(I, 4) = vSrc(I, 2)
        vToSort(I, 5) = MC(0).submatches(0)
        vToSort(I, 6) = MC(0).submatches(1)
        vToSort(I, 7) = Len(vToSort(I, 6))
Next I

'write to hidden sheet for sorting
Set wsSort = Worksheets.Add
With wsSort
    '.Visible = xlSheetHidden
    Set r = .Cells(1, 1).Resize(UBound(vToSort, 1), UBound(vToSort, 2))
    r.Value = vToSort
End With

'sort on the hidden sheet
wsSort.Sort.SortFields.Clear
    wsSort.Sort.SortFields.Add2 Key:=r.Columns(2) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:="BMC,CSR,MC,LC" _
        , DataOption:=xlSortNormal
    wsSort.Sort.SortFields.Add2 Key:=r.Columns(3) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    wsSort.Sort.SortFields.Add2 Key:=r.Columns(5) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    wsSort.Sort.SortFields.Add2 Key:=r.Columns(7) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    wsSort.Sort.SortFields.Add2 Key:=r.Columns(6) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With wsSort.Sort
        .SetRange r
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

'create results array with the needed columns
Dim vRes1 As Variant, vRes2 As Variant

Set r = Union(r.Columns(1), r.Columns(4))

vRes1 = r.Areas(1)
vRes2 = r.Areas(2)
'write back to the original sheet
'but offset for now for trouble shooting

Set r = Worksheets("Telecom").Cells(1, 8).Resize(UBound(vRes1, 1), 2)
With Application
    .ScreenUpdating = False
With r

    .Columns(1).Value = vRes1
    .Columns(2).Value = vRes2
    .EntireColumn.HorizontalAlignment = xlCenter
    .EntireColumn.AutoFit
End With

'delete the hidden sheet
    .DisplayAlerts = False
        'wsSort.Delete
    .DisplayAlerts = True
    .ScreenUpdating = True
End With

End Sub
    
- 1
  1. hi। मैं कोड नहीं था, लेकिन समस्या wheres? इसका परिणाम यह नहीं है कि आप किस तरह की त्रुटि की उम्मीद करते हैं या करते हैं?
    2019-04-09 17: 01: 13Z
  2. हाँ, मुझे अपना कोड अल्फ़ान्यूमेरिक रूप से सॉर्ट करने के लिए नहीं मिल सकता है, जैसा कि @LuisCurado
    के ऊपर दिखाया गया है।
    2019-04-09 18: 02: 28Z
  3. क्या, वास्तव में, स्तंभ C के लिए आपकी छँटाई कर रहे हैं।
    2019-04-09 18: 07: 07Z
  4. क्यों आप एक जटिल छँटाई चाहते हैं ?? मैं केवल यह सोच सकता था कि यह किसी अन्य सूची से मेल खाए, जिसमें इस तरह का संकल्‍प हो। इसका एकमात्र कारण MATCH है। एर्गो, क्यों एक सरल और अधिक सामान्य छँटाई पर मेल नहीं खाते। और इस तरह, सामान्य प्रकार में बीओटीएच सेट करता है। क्यों नहीं ??
    2019-04-09 18: 14: 51Z
  5. यह कुछ अजीब छँटाई है। मैं तीन नए कॉलम बनाऊंगा। पहले हाइफन से पहले संख्यात्मक भाग के लिए =Left(C1, Find("-", C1)-1) होगा। अगला =Len(Right(C1, Len(C1)-Find("-", C1))) होगा, जो हाइफ़न के बाद के हिस्से की लंबाई प्राप्त करेगा। और फिर आखिरी कॉलम 06003509911001001350350 होगा, जो कि हाइफ़न के बाद मिलता है। फिर क्रम में उन तीन स्तंभों द्वारा सब कुछ क्रमबद्ध करें।
    2019-04-09 19: 46: 04Z
    1 उत्तर                              1                         

    ऐसा प्रतीत होता है कि आप क्रमबद्ध करना चाहते हैं

    • स्तंभ B: कस्टम क्रम में स्ट्रिंग के पहले भाग के लिए आरोही
    • स्तंभ B: स्ट्रिंग के दूसरे भाग (संख्यात्मक) के लिए अवरोही
    • कॉलम सी: संख्यात्मक भाग के लिए आरोही
    • कॉलम सी: अल्फा भाग की लंबाई के लिए आरोही
    • स्तंभ C: स्ट्रिंग के अल्फा भाग के लिए आरोही

    कॉलम बी के लिए, दो भागों को हाइफ़न पर विभाजित किया जा सकता है कॉलम सी के लिए, चूंकि हमेशा एक हाइफ़न नहीं होता है, मैंने अल्फा और न्यूमेरिक भागों को विभाजित करने के लिए रेगुलर एक्सप्रेशंस का उपयोग किया, लेकिन अन्य तरीकों का उपयोग किया जा सकता है।

    उपयोग की गई विधि डेटा को कई कॉलमों में विभाजित करने के लिए है, और आवश्यकतानुसार प्रत्येक पर सॉर्ट करें। यह छंटनी एक फेंक-दूर कार्यपत्रक पर की जाती है, और फिर परिणाम मूल शीट पर वापस कॉपी किए जाते हैं।

    कोड के लिए, मैंने डीबगिंग उद्देश्यों के लिए मूल से परिणाम ऑफसेट किए हैं, क्योंकि ऐसे कॉन्फ़िगरेशन हो सकते हैं जिनके लिए आपने जानकारी प्रदान नहीं की है। लेकिन यह आपके परीक्षण डेटा पर वांछित परिणाम उत्पन्न करता है।

    =Right(C1, Len(C1)-Find("-", C1))

     यहां छवि विवरण दर्ज करें

        
    1
    2019-04-10 01: 09: 46Z
    1. धन्यवाद रॉन! मैंने कार्यक्रम में थोड़ा फेरबदल किया। हालाँकि, मैं इसके लिए अपने LC-XXXXX के मूल्यों को केवल क्रमबद्ध करना चाहूंगा। मैं सोच रहा था कि इन नए LC मानों को कुछ हद तक निकालना संभव होगाओ और उन्हें मूल लोगों पर चिपकाएँ?
      2019-04-10 03: 36: 25Z
    2. " आपका नया कार्यक्रम "में कोड प्रदान करने का एक बड़ा हिस्सा है , और इस कोड के साथ समस्या को इंगित करने के लिए कुछ नहीं करता है। और मैं इस बात से नाराज हूं कि आपने सिर्फ इस विचार को विफल किया और इसे आपका नया कार्यक्रम कहा। यदि आप चाहते हैं कि मेरे MC- वाले के बाद आने वाले मान LC- के लिए है, तो बस z से छाँटें। लेकिन यह वह नहीं है जो आप अपने उदाहरणों में दिखाते हैं। अब तक जहां आप चाहते हैं, उन्हें चिपकाने के लिए, आपको बस उस स्थान को बदलने की ज़रूरत है जहाँ वे चिपके हुए हैं। चूंकि आपने मेरे कोड को अपने रूप में लागू किया है, मुझे लगता है कि आप देख सकते हैं कि यह कैसे किया जाता है।
      2019-04-10 11: 16: 12Z
      Option Explicit
      Sub sortAlphaNum()
          Dim ws As Worksheet, r As Range
          Dim wsSort As Worksheet
          Dim vSrc As Variant, vToSort As Variant
          Dim RE As Object, MC As Object
          Const sPat As String = "(\d+)-?(\D*)" 'note that some do not have a hyphen
          Dim I As Long, V As Variant
      
      'input data to variant array
      Set ws = Worksheets("Telecom")
      With ws
          vSrc = .Range(.Cells(1, 2), .Cells(.Rows.Count, 2).End(xlUp)).Resize(columnsize:=2)
      End With
      
      'create array of ColB, and Col C split into Numeric, Alpha & len(alpha) for column c
      'cannot split column 2 on the hyphen since not all requiring a split contain a hyphen.
      
      ReDim vToSort(1 To UBound(vSrc, 1), 1 To 7)
      
      Set RE = CreateObject("vbscript.regexp")
      With RE
          .Global = False
          .ignorecase = False 'or could be true
          .Pattern = sPat
      End With
      For I = 1 To UBound(vSrc, 1)
          Set MC = RE.Execute(vSrc(I, 2))
              vToSort(I, 1) = vSrc(I, 1)
                  V = Split(vSrc(I, 1), "-")
              vToSort(I, 2) = V(0)
              vToSort(I, 3) = V(1)
          Set MC = RE.Execute(vSrc(I, 2))
              vToSort(I, 4) = vSrc(I, 2)
              vToSort(I, 5) = MC(0).submatches(0)
              vToSort(I, 6) = MC(0).submatches(1)
              vToSort(I, 7) = Len(vToSort(I, 6))
      Next I
      
      'write to hidden sheet for sorting
      Set wsSort = Worksheets.Add
      With wsSort
          .Visible = xlSheetHidden
          Set r = .Cells(1, 1).Resize(UBound(vToSort, 1), UBound(vToSort, 2))
          r.Value = vToSort
      End With
      
      'sort on the hidden sheet
      wsSort.Sort.SortFields.Clear
          wsSort.Sort.SortFields.Add2 Key:=r.Columns(2) _
              , SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:="BMC,CSR,MC,LC" _
              , DataOption:=xlSortNormal
          wsSort.Sort.SortFields.Add2 Key:=r.Columns(3) _
              , SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
          wsSort.Sort.SortFields.Add2 Key:=r.Columns(5) _
              , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
          wsSort.Sort.SortFields.Add2 Key:=r.Columns(7) _
              , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
          wsSort.Sort.SortFields.Add2 Key:=r.Columns(6) _
              , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
          With wsSort.Sort
              .SetRange r
              .Header = xlNo
              .MatchCase = False
              .Orientation = xlTopToBottom
              .SortMethod = xlPinYin
              .Apply
          End With
      
      'create results array with the needed columns
      Dim vRes1 As Variant, vRes2 As Variant
      Set r = Union(r.Columns(1), r.Columns(4))
      
      vRes1 = r.Areas(1)
      vRes2 = r.Areas(2)
      
      'write back to the original sheet
      'but offset for now for trouble shooting
      Set r = Worksheets("Telecom").Cells(1, 5).Resize(UBound(vRes1, 1), 2)
      With Application
          .ScreenUpdating = False
      With r
          .EntireColumn.Clear
          .Columns(1).Value = vRes1
          .Columns(2).Value = vRes2
          .EntireColumn.HorizontalAlignment = xlCenter
          .EntireColumn.AutoFit
      End With
      
      'delete the hidden sheet
          .DisplayAlerts = False
              wsSort.Delete
          .DisplayAlerts = True
          .ScreenUpdating = True
      End With
      
      End Sub
      
स्रोत रखा गया यहाँ