एक्सेल मैक्रो - कॉमा पंक्तियाँ

Question

के लिए कक्ष अलग किए मैं एक्सेल में निम्न डेटा होता है:

a, b, c 
d 
e 
f, g 
h 
i 

प्रत्येक पंक्ति के साथ

, एक पंक्ति और एक सेल में प्रतिनिधित्व।

मैं इसे करने के लिए कन्वर्ट करने के लिए करना चाहते हैं:

a 
b 
c 
d 
e 
f 
g 
h 
i 

मैं निम्नलिखित मैक्रो का उपयोग कर रहा है, लेकिन मैं AutoSize बजाय सेल मानों को ओवरराइड की, एक डालने करने के लिए नहीं मिल सकता है। किसी भी मदद की सराहना की है।

Sub SplitCells() 


    Dim i As Long 



    With Application 

     .Calculation = xlCalculationManual 

     .ScreenUpdating = False 




    For i = 1 To Selection.Rows.Count 

     Dim splitValues As Variant 


     splitValues = split(Selection.Rows(i).Value, ",") 

     Selection.Rows(i).Resize(UBound(splitValues) - LBound(splitValues) + 1).Value = Application.Transpose(splitValues) 

    Next i 



     .Calculation = xlCalculationAutomatic 

     .ScreenUpdating = True 

    End With 

End Sub 

Answer 1

इस मैक्रो स्तंभ एक से अपने डेटा का समय लगेगा और स्तंभ बी के लिए यह "निकालने" परिणाम नीचे दिखाए गए हैं, मेरे चित्रमय प्रस्तुति कौशल पर cower को :-) के लिए स्वतंत्र महसूस

<- A -> <- B -> 
1 a, b, c a 
2 d   b 
3 e   c 
4 f, g  d 
5 h   e 
6 i   f 
7    g 
8    h 
9    i 

मैंने इसे परीक्षण उद्देश्यों के लिए विनाशकारी के रूप में छोड़ दिया है, और चूंकि यह एक नया कॉलम बनाने के लिए अपेक्षाकृत आसान है, इसे पॉप्युलेट करें और वीबीए में पुराने कॉलम को हटा दें। पाठक के लिए एक व्यायाम ...

यहाँ मैक्रो है:

Option Explicit 
Sub Macro1() 
    Dim fromCol As String 
    Dim toCol As String 
    Dim fromRow As String 
    Dim toRow As String 
    Dim inVal As String 
    Dim outVal As String 
    Dim commaPos As Integer 

    ' Copy from column A to column B.' 
    fromCol = "A" 
    toCol = "B" 
    fromRow = "1" 
    toRow = "1" 

    ' Go until no more entries in column A.' 
    inVal = Range(fromCol + fromRow).Value 
    While inVal <> "" 

     ' Go until all sub-entries used up.' 
     While inVal <> "" 
      Range(fromCol + fromRow).Select 

      ' Extract each subentry.' 
      commaPos = InStr(1, inVal, ",") 
      While commaPos <> 0 

       ' and write to output column.' 
       outVal = Left(inVal, commaPos - 1) 
       Range(toCol + toRow).Select 
       Range(toCol + toRow).Value = outVal 
       toRow = Mid(Str(Val(toRow) + 1), 2) 

       ' Remove that sub-entry.' 
       inVal = Mid(inVal, commaPos + 1) 
       While Left(inVal, 1) = " " 
        inVal = Mid(inVal, 2) 
       Wend 
       commaPos = InStr(1, inVal, ",") 
      Wend 

      ' Get last sub-entry (or full entry if no commas).' 
      Range(toCol + toRow).Select 
      Range(toCol + toRow).Value = inVal 
      toRow = Mid(Str(Val(toRow) + 1), 2) 
      inVal = "" 
     Wend 

     ' Advance to next source row.' 
     fromRow = Mid(Str(Val(fromRow) + 1), 2) 
     Range(fromCol + fromRow).Select 
     inVal = Range(fromCol + fromRow).Value 
    Wend 
End Sub 

Answer 2

यह अनचाहे है, लेकिन यह एक एल्गोरिदमिक पैटर्न है जिसे मैंने कई बार उपयोग किया है। हालांकि यह थोड़ी देर हो गया है, इसलिए सिंटैक्स पर बिल्कुल भरोसा न करें।

sub SplitCells() 
    Dim c as Range  ' iterator for cells in Selection 
    dim r as Range  ' to hold the range which is the first cell in Selection 
    Dim r2 as Range  ' variable range for single cell which is the target for inserting the result 
    Dim a() a Variant ' array of variants to hold each cell's value after it's split 
    Dim b() as Variant ' array of variants to hold the accumulation of values to spread into the destination 
    Dim v ar Variant ' variant to iterate through b for insertion 
    Dim i as Integer ' cumulative offset from top of destination range while inserting 

    For each c in Selection.Cells 
     a = Split(Replace(c.Text, ",", "")) ' will split on whitespace 
     for each v in a 
      b.Add v 
     next v 
    next c 

    ' now you have a new array with the full set of values 

    ' insert them a row at a time using Range.Offset 
    i = 0 
    Set r = Selection.Cells(0) 
    For Each v in b 
     Set r2 = r.Offset(1, 0) 
     r2.Value = v 
     i = i + 1 
    next v 
End Sub 

Answer 3

मैं Excel VBA में बहुत अच्छा नहीं कर रहा हूँ, लेकिन यह काम किया (किसी भी तरह !!)

Sub arrange() 

' get the current range from the sheet 
    curr_range = ActiveSheet.Range("A1:A6") 

' for each cell in that range ... 
    For Each Row In curr_range 

' ...put the contents into an array 
     arr = Split(Row, ",") 

' for each cell in that array ... 
     For Each cell In arr 

' ...output it into a string 
      output_str = output_str & "," & cell 
     Next cell 

    Next Row 

' remove spaces 
    output_str = Replace(output_str, " ", "") 
' remove left , 
    output_str = Right(output_str, Len(output_str) - 1) 

' make it into an array 
    output_arr = Split(output_str, ",") 

' populate the sheet back 
    ActiveSheet.Range("A:A").Value = Application.WorksheetFunction.Transpose(output_arr) 

End Sub