আপডেট করুন এবং ভিবিএ এক্সেল মধ্যে দুটি মাপকাঠি উপর ভিত্তি করে সারি যোগ করুন

Question

যে কেউ আমাকে ভিবিএতে একটি কোড লিখতে সাহায্য করতে পারে যা একটি টেবিল আপডেট করে, অথবা দুটি কলামের মানদণ্ডের ভিত্তিতে নতুন ডেটা যোগ করে?

উদাহরণস্বরূপ, একটি নাম কলাম এবং একটি প্রকল্প কলাম থাকতে পারে এবং আমরা প্রকল্প 1 এ মার্ক কাজ করে কিনা তা যাচাই করতে চাই। যদি প্রজেক্ট 1 এ মার্ক কাজ করে তবে তার সারিটি আলাদা স্প্রেডশীট থেকে নতুন ডেটা দিয়ে আপডেট করুন। মার্ক স্প্রেডশীটে প্রকল্প 2 এ কাজ করলে, তবে মূল স্প্রেডশীটে নথিভুক্ত করা হয় না, মার্ক এবং প্রজেক্ট 2 যুক্ত করুন, সেই সারির তথ্য সহ। যদি Betty প্রকল্প 1 তে কাজ করে এবং আসল স্প্রেডশীটটিতে এই তথ্য থাকে তবে এই সারিটি আপডেট করুন। যদি Betty project2 তে কাজ করে তবে মূল স্প্রেডশীটটিতে এই তথ্য নেই, এটি একটি নতুন সারি হিসাবে যুক্ত করুন। সুতরাং নাম এবং প্রকল্প উভয় টেবিলের মধ্যে একাধিক বার প্রদর্শিত হবে, শুধু বিভিন্ন সমন্বয় সঙ্গে।

তাই ধারণা একই সময়ে উভয় কলাম চেক করা, এবং আপডেট অনুযায়ী এবং নতুন তথ্য যোগ করুন।

এখানে আমার এখন ত্রুটিযুক্ত কোড আছে:

Dim filename As String
Dim ManagerLEs As Workbook
Dim ProjectLEs As Workbook
Set ProjectLEs = ThisWorkbook

filename = Application.GetOpenFilename("Word files (*.xlsx),*.xlsx", , "Browse for file containing table to be imported")

If filename = Empty Then
    Exit Sub
End If

Set ManagerLEs = Application.Workbooks.Open(filename)

Dim first_blank_row As Long
first_blank_row = Cells.SpecialCells(xlCellTypeLastCell).Offset(1, 0).Row
starting_row = 4

Dim r As Long

r = starting_row

Dim namefound As Range
Dim projectfound As Range

firstname = ManagerLEs.ActiveSheet.Range("a" & r).Value
projectname = ManagerLEs.ActiveSheet.Range("d" & r).Value

Do While firstname <> 0

Set namefound = Columns("a:a").Find(what:=firstname, LookIn:=xlValues, lookat:=xlWhole)
Set projectfound = Columns("d:d").Find(what:=projectname, LookIn:=xlValues, lookat:=xlWhole)

    'look for current ticket number in main file
    If (namefound Is Nothing And projectfound Is Nothing) Then

        'add info to end of main file
        For c = 1 To 57
        ProjectLEs.Worksheets("Template").Cells(first_blank_row, c) = ManagerLEs.Worksheets("LEs").Cells(r, c)
        first_blank_row = first_blank_row + 1
        Next c
    Else

        'overwrite existing line of main file
        For c = 1 To 57
        ProjectLEs.Worksheets("Template").Cells(namefound.Row, c) = ManagerLEs.Worksheets("LEs").Cells(r, c)
        Next c
    End If

        r = r + 1
        firstname = ManagerLEs.ActiveSheet.Range("a" & r).Value
        projectname = ManagerLEs.ActiveSheet.Range("d" & r).Value
Loop

ধন্যবাদ!

Comments

আপনার লেখা কোডটি পোস্ট করার চেষ্টা করুন এবং যেখানে আপনি আটকে আছেন। সম্পূর্ণ সমস্যার চেয়ে একটি নির্দিষ্ট সমস্যাটি মোকাবেলা করা অনেক সহজ।

— Engineer Toast

Answer 1

আমি এই ধরনের প্রয়োজনের জন্য পাওয়ার কোয়েরি অ্যাড-ইন ব্যবহার করব। এটি মার্জ এবং অ্যাডেন্ড সহ ডেটা রূপান্তর করার জন্য অনেকগুলি ফাংশন রয়েছে। আপনি বোতামে ক্লিক করে একটি চাক্ষুষ UI এ আপনার ক্যোয়ারী তৈরি করেন (এটি কোড জেনারেট করে) এবং প্রতিটি ধাপে ফলাফলের তথ্য দেখতে পারেন।

https://support.office.com/en-us/article/Microsoft-Power-Query-for-Excel-Help-2b433a85-ddfb-420b-9cda-fe0e60b82a94?ui=en-US&rs=en-001& বিজ্ঞাপন মার্কিন =

Answer 2

এই কোড চেষ্টা করে, কাজ করে না।

Sub importLEs()

With Excel.Application
    .ScreenUpdating = False
    .Calculation = Excel.xlCalculationManual
    .EnableEvents = False
End With

Dim filename As String
Dim ManagerLEs As Workbook
Dim ProjectLEs As Workbook
Set ProjectLEs = ThisWorkbook

'open file that you are importing data from
filename = Application.GetOpenFilename("Word files (*.xlsx),*.xlsx", , "Browse for file containing table to be imported")

If filename = Empty Then
    Exit Sub
End If

Set ManagerLEs = Application.Workbooks.Open(filename)

Dim first_blank_row As Long

first_blank_row = Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
starting_row = 4

Dim r As Long
Dim rr As Long

r = starting_row
rr = 4

firstname = ManagerLEs.ActiveSheet.Range("a" & r).Value
projectname = ManagerLEs.ActiveSheet.Range("d" & r).Value
mastername = ProjectLEs.Worksheets("Template").Range("a" & rr).Value
masterproject = ProjectLEs.Worksheets("Template").Range("d" & rr).Value

Do While firstname <> 0

    'counter to check if a row is updated
    flag = False

    Do While mastername <> 0

        If mastername = firstname And masterproject = projectname Then

            'update existing line of main file
            For c = 10 To 57
            ProjectLEs.Worksheets("Template").Cells(rr, c) = ManagerLEs.Worksheets("LEs").Cells(r, c)
            Next c
            flag = True
            Exit Do

        End If

    Loop

        'if data does not exist, append data to the end of main file
        If flag = False Then

            For c = 1 To 57
            ProjectLEs.Worksheets("Template").Cells(first_blank_row, c) = ManagerLEs.Worksheets("LEs").Cells(r, c)
            Next c

        End If

        first_blank_row = first_blank_row + 1
        rr = rr + 1
        r = r + 1
        firstname = ManagerLEs.ActiveSheet.Range("a" & r).Value
        projectname = ManagerLEs.ActiveSheet.Range("d" & r).Value
        mastername = ProjectLEs.Worksheets("Template").Range("a" & rr).Value
        masterproject = ProjectLEs.Worksheets("Template").Range("d" & rr).Value

Loop

With Excel.Application
    .ScreenUpdating = True
    .Calculation = Excel.xlAutomatic
    .EnableEvents = True
End With

End Sub

একটু সাহায্য দরকার।