এক শীটে অন্য সারিতে দুটি সারি অনুলিপি করার জন্য কলামের মানদণ্ড সহ এক্সেল ম্যাক্রো

Question

আমার একটি ম্যাক্রো দরকার যা কলামে স্ট্রিং সন্ধান করে; সেই স্ট্রিংটি সন্ধান করার পরে এটি সেই সারিটি অনুলিপি করে যেখানে সেই স্ট্রিংটি পাওয়া যায় পাশাপাশি তার উপরে থাকা সারিটিও।

উদাহরণ স্বরূপ:

5 কলামে "ছেলে" অনুসন্ধান করুন; যদি সারি 6 এ পাওয়া যায়, সারি 6 এবং সারি 5 অনুলিপি করুন; তারপরে 5 কলামে পরবর্তী "ছেলে" অনুসন্ধান করুন।

কিভাবে আমি এটি করতে পারব?

Comments

আপনি অনুলিপি সারিটি কোথায় আটকাতে চান?

পরের শীটে

— কিসেম্বো ও জুলিয়াস

Answer 1

Heres আপনার ম্যাক্রো হয়

Sub Findining()

    Dim Col As Range
    Dim fs As Worksheet
    Dim s As String
    Dim ws As Worksheet
    Dim r As Range

    Set fs = Sheets(ActiveSheet)
    Set Col = Application.InputBox("Select Column to Look Through", Type:=8)
    If Col.Columns.Count > 1 Then
      Do Until Col.Columns.Count = 1
        MsgBox "You can only select 1 column"
        Set Col = Application.InputBox("Select Column to Compare", Type:=8)
      Loop
    End If

    s = InputBox("Enter string to search for:", "Enter String")
    Set ws = Sheets(fs.Index + 1)
    c = Split(Col.Address, "$")(1)

    For i = 1 To fs.Range(c & Rows.Count).End(xlUp).Row
        Set r = fs.Range(c & i)
        If StrComp(r, s, vbTextCompare) = 0 Then
            fs.Rows(r.Row & ":" & r.Row).Copy
            ws.Activate
            ws.Rows(ws.Range(c & Rows.Count).End(xlUp).Row + 1 & ":" & ws.Range(c & Rows.Count).End(xlUp).Row + 1). _
                PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        End If
        Set r = Nothing
        fs.Activate
    Next i

End Sub