আমি কি দ্রুত এই ম্যাক্রো চালাতে পারি? [নকল]

Question

এই প্রশ্নটি ইতিমধ্যে একটি উত্তর আছে:

• একাধিক কক্ষে আমি কীভাবে নির্দিষ্ট পাঠ্য মুছে ফেলব? 3 উত্তর

আমি 1000 টির বেশি এন্ট্রির জন্য এই ম্যাক্রো ব্যবহার করছি। কোড নিজেই আমি চাই এটা ভাবে কাজ করে।

Option Explicit
Sub DoTheThing()
 Dim keepValueCol As String
 keepValueCol = "H"

 Dim row As Integer
 row = 2

 Dim keepValueRow As Integer
 keepValueRow = 1

 Do While (Range("E" & row).Value <> "")

    Do While (Range(keepValueCol & keepValueRow).Value <> "")

    Range("E" & row).Value = Replace(Range("E" & row).Value, Range(keepValueCol & keepValueRow).Value, "")
    Range("E" & row).Value = Trim(Replace(Range("E" & row).Value, "  ", " "))

    keepValueRow = keepValueRow + 1
    Loop


 keepValueRow = 1
 row = row + 1
 Loop

End Sub

আমার সমস্যা হচ্ছে ম্যাক্রো চিরতরে চলতে চলেছে; আপনাকে একটি ধারণা দিতে, এই ম্যাক্রোটি +1000 এন্ট্রিগুলিতে 4 ঘন্টা চলছে এবং আমি কখন শেষ হবে তা জানি না।

এই কোড দ্রুত চালানোর জন্য অনুকূলিতকরণ করা যাবে এবং কোড নিজেই অখণ্ডতা আপস করা একটি উপায় আছে কি?

যেকোন এবং সমস্ত সাহায্য প্রশংসা করা হবে।

Comments

আপনি একটি ন্যস্ত লুপ আছে তাই 1000 সারিতে আপনি 1000 সারি বা মোট সারি জুড়ে 1 মিলিয়ন loops এটি দেখার পরিবর্তে।

— cybernard

@ লিবার্নার্ড যদি লুপটি সরিয়ে ফেললে কোডটির প্রভাব কি বদলাবে? এবং যদি আপনি না বলে থাকেন, তবে দয়া করে আমাকে কীভাবে লুপটি সরানোর কথা বলতে পারেন যাতে কোডটি এখনও তার অনুমিত এবং কোনটি ভুল না হয় তা করতে পারে?

— Jase

ট্রিম (প্রতিস্থাপন করুন (রেঞ্জ ("ই" এবং সারি)। ভ্যালু, "", ""))) আমি যদি সঠিকভাবে 2 টি স্থান অনুসন্ধান করে দেখি এবং এটি 1 দিয়ে প্রতিস্থাপন করি এবং তারপর স্থানটি ট্রিম করে ফেলুন, যার ফলে NULL হয়। এই সহজ প্রতিস্থাপন করুন (বিন্যাস ("ই" এবং সারি)। ভ্যালু, "", "") অথবা NULL দিয়ে 2 টি স্থান প্রতিস্থাপন করুন যা তাদের মধ্যে কিছুই না থাকা 2 উদ্ধৃতি চিহ্ন।

— cybernard

ঠিক আছে, আমি মনে করি তুমি বুঝতে পারছো কি? কিন্তু কোডে লুপ শেষের দিকে দুবার লেখা আছে ... আমি কি মুছে ফেলব নাকি না?

— Jase

আপনি কি আপনার ম্যাক্রোকে H1 এর সমস্ত মানের জন্য E1 অনুসন্ধান করতে চান? (H1: h1000 বলুন) এবং এটি NULL ("") দিয়ে প্রতিস্থাপন করুন এবং তারপর E2 এ যান এবং সমগ্র H কলামটি অনুসন্ধান করুন? অথবা আপনি কি H1 এবং H2 এর জন্য E1 অনুসন্ধান করতে চান?

— cybernard

Answer 1

আমি যদি বুঝতে পারি, আপনি কলাম এইচ এ সব মান নিতে চান এবং তাদের কলাম ই থেকে মুছে ফেলতে চান? আমি এটি গতিতে কিছু অ্যারে সঙ্গে যে করতে চাই -

Option Explicit
Sub DoTheThing()
Application.ScreenUpdating = False
Dim lastrow As Integer
'Find last row in column H to size our array
lastrow = ActiveSheet.Cells(Rows.Count, "H").End(xlUp).row

'Declare the array and then resize it to fit column H
Dim varkeep() As Variant
ReDim varkeep(lastrow - 1)

'Load column H into the array
Dim i As Integer
For i = 0 To lastrow - 1
    varkeep(i) = Range("H" & i + 1)
Next

Dim member As Variant
'find last row in column E
lastrow = ActiveSheet.Cells(Rows.Count, "E").End(xlUp).row

'loop each cell in column E starting in row 2 ending in lastrow
For i = 2 To lastrow
    'Make a new array
    Dim myArray As Variant
    'Load the cell into the array
    myArray = Split(Cells(i, 5), " ")
    Dim k As Integer
    'for each member of this array
    For k = LBound(myArray) To UBound(myArray)
        member = myArray(k)
        'call the contains function to check if the member exists in column H
        If Contains(varkeep, member) Then
            'if it does, set it to nothing
            myArray(k) = vbNullString
        End If
    Next
    'let's reprint the array to the cell before moving on to the next cell in column E
    Cells(i, 5) = Trim(Join(myArray, " "))
Next
Application.ScreenUpdating = True
End Sub


Function Contains(arr As Variant, m As Variant) As Boolean
    Dim tf As Boolean
    'Start as false
    tf = False
    Dim j As Integer
        'Search for the member in the keeparray
        For j = LBound(arr) To UBound(arr)
            If arr(j) = m Then
                'if it's found, TRUE
                tf = True
                Exit For
            End If
        Next j
        'Return the function as true or false for the if statement
        Contains = tf
End Function

এটি কলাম এইচ এর বাইরে একটি অ্যারে তৈরি করে। তারপর এটি কলাম E- এর প্রতিটি কক্ষের মধ্য দিয়ে যায়, এটি একটি অ্যারে করে দেয়, অ্যারের প্রতিটি অ্যারেকে রাখা অ্যারের বিরুদ্ধে অনুসন্ধান করে এবং যদি পাওয়া যায়, অ্যারের সেই সদস্যটিকে মুছে ফেলে। কোষের মধ্য দিয়ে যাওয়ার পরে, এটি অনুপস্থিত লোকেদের সাথে অ্যারেটি পুনঃপ্রণোদিত করে।

---

অ্যারে সাধারণত আইটেম দ্বারা আইটেম যাওয়া চেয়ে দ্রুত, কিন্তু উপরন্তু, আমরা ব্যবহার করে বরং আমাদের নিজস্ব ফাংশন তৈরি করছি ধীর Find and Replace পদ্ধতি। তথ্য মধ্যে অতিরিক্ত স্থান থাকতে পারে যে একমাত্র সমস্যা। যদি তাই হয়, আমরা দ্রুত খুঁজে পেতে এবং প্রতিস্থাপন করতে পারেন। আমি অ্যারের পুনরায় আকার এবং উপাদান সরানো পরিবর্তে অ্যারের সদস্যদের সেট করা সহজ পাওয়া যায়।

Answer 2

আপনি ম্যানুয়াল গণনা সেটিং করার চেষ্টা করেছেন? (এক্সেল 2013) Formulas - Calculation Options - Manual

"E" কলামের মানগুলির মধ্যে কলাম "এইচ" মানের মানগুলির সমস্ত ঘটনাগুলি সরাতে আপনার উদ্দেশ্যটি দেখায়।

আপনি সামগ্রী রপ্তানি এক্সপোর্ট এবং আপনার ইচ্ছা পরিবর্তন সঞ্চালন ছাড়া অন্য একটি সরঞ্জাম ব্যবহার বিবেচনা করেছেন?

Comments

হ্যাঁ, ঠিক আমি যা করছি তা হচ্ছে, কিন্তু একমাত্র পার্থক্য হল যে কলাম ই থেকে আমি যে একাধিক মান অপসারণ করতে চাই তা কোষগুলিতে রয়েছে। H কলামটি ই-তে কোষ থেকে সরাতে চান এমন একটি রেফারেন্স বিন্দু। আমি MAC এর জন্য 2011 অফিস ব্যবহার করছি। - কি এই টুলটি সহজে এই সব তথ্য বাছাই করতে পারেন? আমি এটা বিবেচনা না, কিন্তু এটি একটি সহজ বিকল্প মত শোনাচ্ছে? তাই কি?

— Jase

Answer 3

আপনার কোডটি কলাম এইচ-তে যেকোন মান খুঁজে বের করে কলাম E- এ মানগুলি আপডেট করছে। তবে, এটি প্রতিটি সময় কেবলমাত্র একটি ঘর দেখার মাধ্যমে খুব অদক্ষভাবে কাজ করছে। আপনি একবার কলাম ই সমগ্র পরিসর সঙ্গে ডিলিং দ্বারা অনেক ভাল করতে পারেন। এছাড়াও, আপনি যখন কোন একক সেল দেখছেন তখনও কলামের জন্য একটি স্ট্রিং এবং সারির একটি নম্বর সংযোজন করার পরিবর্তে এটি অ্যাক্সেস করতে একটি রেঞ্জ বস্তুর ব্যবহার করা আরও সহজ।

এই কোডটি আপনার মত একই জিনিসটি করা উচিত, তবে এটি রেঞ্জ বস্তুর প্রতিস্থাপন পদ্ধতিটি ব্যবহার করে একবার কলাম E এর সমস্ত মানগুলি প্রক্রিয়া করে (যা UI এ সমস্ত প্রতিস্থাপন করার মতো একই কার্যকারিতা)। এই অনেক দ্রুত হতে হবে।

প্রথমে Replace নিচে কল, দী True চূড়ান্ত যুক্তি একটি কেস সংবেদনশীল সংবেদনশীল নির্দেশ করে। যদি আপনি একটি কেস-অসংবেদী ম্যাচ চান, এটিতে পরিবর্তন করুন False।

Option Explicit
Sub DoTheThing()

  Dim UpdateRange As Range, ReplaceCell As Range, dummy As Boolean

  Set UpdateRange = Range("E2", Range("E2").End(xlDown))
  Set ReplaceCell = Range("H1")

  Do While (ReplaceCell.Value <> "")
    dummy = UpdateRange.Replace(ReplaceCell.Value, "", xlPart, , True)
    dummy = UpdateRange.Replace("  ", " ", xlPart)
    Set ReplaceCell = ReplaceCell.Offset(1, 0)
  Loop

End Sub

Comments

প্রথমত, এই জন্য আপনাকে অনেক ধন্যবাদ! আমি শুধু এটি চেষ্টা করেছি এবং এটি তালিকার মধ্যে কাজ করে নি, তবে আমি নিশ্চিত করতে পারি যে এটি কিছুটা কাজ করেছে। ই কলামটিতে তার কোষগুলির মধ্যে একাধিক পাঠ্য রয়েছে এবং প্রায় +1000 টি কক্ষ রয়েছে। H কলামটিতে E যে কোনও পাঠ্য রয়েছে যা E এর কোষ থেকে মুছে ফেলা প্রয়োজন। H কলামটিতে পৃথক কোষে পাঠ্য রয়েছে এবং +6000 পর্যন্ত যায়। যেমনটি আমি আগে বলেছি, এইচ কলামটি কলাম ই থেকে মুছে ফেলার প্রয়োজন হিসাবে একটি রেফারেন্স হিসাবে কাজ করে। এটি বলে, কোডটি কি প্রত্যাশিত ফলাফল প্রতিফলিত করতে পরিবর্তিত হতে পারে?

— Jase

Answer 4

দেখানো হিসাবে প্রবেশ করান

    if (Range("E"&row).value="") then
      Exit Do
    End if

পরে ২ বিন্যাস ("ই" এবং সারি) কমান্ড উপরের যোগ করুন।

একবার আপনি NULL দিয়ে মানটি প্রতিস্থাপন করার পরে কোনও কলাম H অনুসন্ধানের জন্য কোনও বিন্দু নেই কারণ E হল NULL। সুতরাং যদি সারি 2 এ NULL হয় তবে কলাম H তে 3-1000 সারিতে কোনও বিন্দু অনুসন্ধান করা হয় না তাই লুপটি ভেঙে E3 এ যান।

এছাড়াও কলাম এইচ ক্রম গুরুত্বপূর্ণ। যদি সম্ভব হয় তবে সর্বাধিক সাধারণ কলাম কলাম এইচ এর শীর্ষে থাকা উচিত তাই এটি তালিকাটি অকার্যকর বা এলোমেলো হওয়ার মতো হ'ল এটির বেশি অনুসন্ধান করতে হবে না।

Comments

আমি সাহায্যের প্রশংসা করি, এবং আমি এটি পরীক্ষা করেছি এবং একটি ত্রুটি আছে। হয়তো আমি কিছু ভুল করছি? দুঃখিত কিন্তু আমি এই নতুন।

— Jase

@ জেস কি ভুল?

— cybernard

একটি ত্রুটি পপ আপ সঙ্গে আগে হাইলাইট টেক্সট একটি বিট ছিল। আমি আবার আপনার নির্দেশাবলী পড়া এবং এটি চলমান। বিটিউ, আমি জানি না এটি গুরুত্বপূর্ণ কিনা বা না, কিন্তু দুটি লুপ কমান্ড এখনও আছে। যখন আমি এটি মুছে ফেলার চেষ্টা করি, আরেকটি ত্রুটি বলে যে এটি লুপ কমান্ড ছাড়া এটি করতে পারে না, তাই আমি আবার কিছুটা কোড যোগ করেছি।

— Jase

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

— Jase

এখন জন্য উভয় loops ছেড়ে। আমি আরো একটি ধারনা আছে, যে দ্রুত কোনো যদি আমাকে জানাতে। যদি সেল E1 একটি থাকে সম্পূর্ণ ম্যাচ এইচ থেকে আপনি একটি করতে পারে যদি Application.WorksheetFunction.VLookup (রেঞ্জ ("ই" এবং সারি)। ভ্যালু, রেঞ্জ ("এইচ: এইচ"), 1, মিথ্যা) & lt; & gt; মিথ্যা তারপর বিন্যাস ("ই" এবং সারি)। ভ্যালু = "" কিন্তু এইচ পূর্ণ ম্যাচ ই কি?

— cybernard

Answer 5

আমি পার্টি দেরিতে যোগদান করছি, কিন্তু আমি সমাধানগুলিতে আমার দুটি সেন্ট রাখতে চাই।

এই কোড মান জন্য সন্ধান করা হবে column H (8) এবং তাদের জন্য প্রতিস্থাপন "" কলাম ই উপর।

কলাম E তে সেল দ্বারা সেল যাচ্ছে পরিবর্তে এটি সম্পূর্ণ কলামে প্রতিস্থাপন করে, তাই এটি কলাম এইচ এর মানগুলির উপর একটি লুপ করবে।

Public Sub big_search()
Dim wkb As Workbook
Dim wks As Worksheet
Set wkb = ThisWorkbook
Set wks = wkb.Sheets(1)
thisrow = 1
existe = True
inicio = Format(Now(), "yyyymmddhhmmss")
While existe
    ' keep in mind that the column H is the 8th
    selectionvalue = wks.Cells(thisrow, 8)
    If selectionvalue <> "" Then
        wks.Columns("E").Replace What:=selectionvalue, Replacement:="", SearchOrder:=xlByColumns, MatchCase:=True
        thisrow = thisrow + 1
    Else
        existe = False
    End If
Wend
fin = Format(Now(), "yyyymmddhhmmss")
a = MsgBox(fin - inicio & " seconds", vbOKOnly)
End Sub