এক্সেল: একটি কোষের ভিতরে কমা আলাদা মূল্য - প্রতিটি সংমিশ্রণ দ্বারা তৈরি আরও সারিতে বিস্ফোরিত হয়

Question

আমি দ্বিতীয় টেবিলে প্রথম টেবিল মত কিছু থেকে যেতে চান:

... একটি পিভট টেবিল ব্যবহার করার জন্য। আমি প্রথম টেবিলে এক শীটে থাকতে চাই, এবং দ্বিতীয় টেবিলটি আরেকটি শীট হতে চাই, এই "বিস্ফোরিত" দ্বিতীয় টেবিলের লাইভ-আপডেট করা। আমি কিছুক্ষন চেষ্টা করেছি এবং কাজ করতে পারছি না। কোনও পরামর্শ? আমি যে ফর্মটি ব্যবহার করছি তা এই তালিকা-টাইপের একক কোষে কমা বিভাজিত মানগুলিকে আউটপুট করছে এবং এই ক্ষেত্রে এটি হাজার হাজার সারির মতো ম্যানুয়ালি করতে কার্যকরী নয়।

Comments

প্রথম টেবিল কত বড়? প্রতিটি স্লট জন্য কত মোট সম্ভাব্য মান আছে?

— Adam

থ্রেড একটি চেহারা নিন এখানে কিছু tweaking প্রয়োজন কিন্তু শুরু করার জন্য একটি ভাল জায়গা।

— gtwebb

"লাইভ আপডেট"?

— Raystafarian

প্রথম টেবিলটি প্রায় 50 টি সারি এবং 10 টি কলাম থাকবে। শুধুমাত্র 2 কলাম কমা তালিকা আছে। প্রথমটি সর্বাধিক 14 টি উপাদান, দ্বিতীয়টি সর্বাধিক 5 টি উপাদান।

— Ben Brook

এবং এই ডেটা সহ শীট 1 এ পূরণ করার মতো "লাইভ আপডেটিং" হিসাবে, শীট 2টিতে এমন ফাংশন রয়েছে যা শীট 1 টি ডাটা প্রসারিত সারির মধ্যে সম্প্রসারিত সারিতে বিস্ফোরিত করবে। এটি একটি ফর্ম হিসাবে, শীট 1 নতুন সারি পেতে থাকবে

— Ben Brook

Answer 1

আমি স্ক্রিপ্ট পরিবর্তন gtwebb প্রদান লিঙ্ক থেকে । এখানে স্ক্রিপ্ট হয়:

Option Explicit

Sub Main()

Columns("B:B").NumberFormat = "@"
Dim i As Long, c As Long, r As Range, v As Variant

For i = 1 To Range("B" & Rows.Count).End(xlUp).Row
    v = Split(Range("B" & i), ", ")
    c = c + UBound(v) + 1
Next i

For i = 2 To c
    Set r = Range("B" & i)
    Dim arr As Variant
    arr = Split(r, ", ")
    Dim j As Long
    r = arr(0)
    For j = 1 To UBound(arr)
        Rows(r.Row + j & ":" & r.Row + j).Insert Shift:=xlDown
        r.Offset(j, 0) = arr(j)
        r.Offset(j, -1) = r.Offset(0, -1)
        r.Offset(j, 1) = r.Offset(0, 1)
    Next j
Next i

Columns("C:C").NumberFormat = "@"
Dim k As Long, d As Long, s As Range, w As Variant

For k = 1 To Range("C" & Rows.Count).End(xlUp).Row
    w = Split(Range("C" & k), ", ")
    d = d + UBound(w) + 1
Next k

For k = 2 To d
    Set s = Range("C" & k)
    Dim arrb As Variant
    arrb = Split(s, ", ")
    Dim m As Long
    s = arrb(0)
    For m = 1 To UBound(arrb)
        Rows(s.Row + m & ":" & s.Row + m).Insert Shift:=xlDown
        s.Offset(m, 0) = arrb(m)
        s.Offset(m, -1) = s.Offset(0, -1)
        s.Offset(m, -2) = s.Offset(0, -2)
    Next m
Next k
End Sub

যেহেতু আমি শুধুমাত্র দুটি কলামের জন্য এটি প্রয়োজন ছিল তাই আমি looping সঙ্গে বিরক্ত না। পরিবর্তিত একমাত্র জিনিস স্ক্রিপ্টটি দ্বিতীয়বার পুনরাবৃত্তি করা হয়, ভেরিয়েবল পরিবর্তিত হয়, এবং Offset পরামিতি পরিবর্তন করা হয়।