[حل شده] کد ثبت اطلاعات پرسنل براساس مدیر مستقیم

[12345678910]

سلام خدمت همه بزرگواران

بنده یه فایل واسه ثبت اطلاعات دارم که به پیوست قابل مشاهده هستش.این فایل توسط چند نفر استفاده میشه مشکلی که دارم این هستش که برای تسریع درانجام کار کدی نیاز دارم ، که اگر مدیر مستقیم هرکارمند در LIST امتیازی واردکرده باشه مدیربعدی با کلیک برروی یک شیپ ( درفایل وجود دارد ) و یا با استفاده ازفرم، همون اطلاعات وامتیازثبت شده برای اون کارمند به اسم مدیر جدید به LIST اضافه بشه.توی شیت INFO کارمندهای زیر نظر هرمدیر قرار دارد
مثال:
ثبت شده توسط مدیر مستقیم در LIST:

نام ارزیابی کننده	نام پرسنل	کد پرسنلی	شماره تماس	شرح وظایف	امتیاز کاری
a	امید	12345	1000	ارائه گزارش	1

ثبت شده توسط مدیر بعدی:

نام ارزیابی کننده	نام پرسنل	کد پرسنلی	شماره تماس	شرح وظایف	امتیاز کاری
a	امید	12345	1000	ارائه گزارش	1
c	امید	12345	1000	ارائه گزارش	1

[M_ExceL]

سلام خدمت همه بزرگواران

بنده یه فایل واسه ثبت اطلاعات دارم که به پیوست قابل مشاهده هستش.این فایل توسط چند نفر استفاده میشه مشکلی که دارم این هستش که برای تسریع درانجام کار کدی نیاز دارم ، که اگر مدیر مستقیم هرکارمند در LIST امتیازی واردکرده باشه مدیربعدی با کلیک برروی یک شیپ ( درفایل وجود دارد ) و یا با استفاده ازفرم، همون اطلاعات وامتیازثبت شده برای اون کارمند به اسم مدیر جدید به LIST اضافه بشه.توی شیت INFO کارمندهای زیر نظر هرمدیر قرار دارد
مثال:
ثبت شده توسط مدیر مستقیم در LIST:

نام ارزیابی کننده	نام پرسنل	کد پرسنلی	شماره تماس	شرح وظایف	امتیاز کاری
a	امید	12345	1000	ارائه گزارش	1

ثبت شده توسط مدیر بعدی:

نام ارزیابی کننده	نام پرسنل	کد پرسنلی	شماره تماس	شرح وظایف	امتیاز کاری
a	امید	12345	1000	ارائه گزارش	1
c	امید	12345	1000	ارائه گزارش	1

سلام،
فایل پیوست رو اجرا کنید سپس داخل شیت Form اطلاعات مختلف وارد کرده و چک کنید.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = Range("c5").Address Then
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
            Dim rngl, rngi, lrang, irang As Range
            Set lrang = Sheets(2).Range("b3:b14")
            Set irang = Sheets(3).Range("a1:a9")
                For Each rngi In irang
                    If Range("c5") = rngi Then
                        For Each rngl In lrang
                            If Range("c5") = rngl Then
                                Range("c7") = rngl.Offset(, 1)
                                Range("c9") = rngl.Offset(, 2)
                                Range("c11") = rngl.Offset(, 3)
                                Range("c13") = rngl.Offset(, 4)
                                .EnableEvents = True
                                .ScreenUpdating = True
                            Exit Sub
                            End If
                        Next rngl
                    End If
                Next rngi
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End If
End Sub

[12345678910]

سلام دوست عزیز
ممنونم از بابت محبتتون
امکانش هست که بدون نمایش دادن اطلاعات ازقبل ثبت شده فقط با پر کردن نام ارزیابی کننده و نام پرسنل اینکار رو انجام داد؟یعنی همین دومورد انتخاب بشه وبعد از کلیک بر روی "ثبت امتیاز براساس مدیر مستقیم" اطلاعات ازتولیست شناسایی و جایی گذاری بشه بدون اینکه نفربعدی ببینه اون اطلاعات رو

[12345678910]

سلام دوست عزیز
ممنونم از بابت پیگیری و محبتتون،خیلی کارمو راه انداخت،فقط یه خواهش دارم اگر ممکنه مواردی که درپاراگراف بعدی توضیح میدم بررسی بفرمایید ببینید قابل اجرا هستش؟
1. من برای شیت list پسورد میذارم و اطلاعات برای همه دردسترس نیست ،وقتی که انتخاب میکنم نام پرسنل رو اطلاعات نمایش داده میشه امکانش هست بدون نمایش دادن اطلاعاتش اینکار انجام بشه؟
2.وقتی نام پرسنل رو انتخاب میکنم بعد ازنمایش اطلاعات اگر بخوام نام پرسنل رو تغییر بدم اطلاعاتی که نمایش داده شده پاک نمیشه و این باعث میشه دیتای اشتباهی ثبت بشه.
3.امکانش هست با استفاده از فرم یا شیپ ثبت اطلاعات مورد نظر بنده انجام بشه؟

[majid_mx4]

با سلام
ضمن تشکر ازدوست عزیز جناب M_ExceL با کسب اجازه از ایشان با کمی اصلاح کد ارائه شده فکر نتیجه دلخواه شما شود .

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = Range("c5").Address Then
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
            Dim rngl, rngi, lrang, irang As Range
            Set lrang = Sheets(2).Range("b3:b14")
            Set irang = Sheets(3).Range("a1:a9")
                For Each rngi In irang
                  If Range("c5") <> rngi Then
                 Range("c7") = ""
                                Range("c9") = ""
                                Range("c11") = ""
                                Range("c13") = ""
                                
           Else
        
        If Range("c5") = rngi Then
                        For Each rngl In lrang
                            If Range("c5") = rngl Then
                                Range("c7") = rngl.Offset(, 1)
                                Range("c9") = rngl.Offset(, 2)
                                Range("c11") = rngl.Offset(, 3)
                                'Range("c13") = rngl.Offset(, 4)
                                .EnableEvents = True
                                .ScreenUpdating = True
                            Exit Sub
                            End If
                        Next rngl
                   End If
                End If
                Next rngi
               
                
        .EnableEvents = True
        
        .ScreenUpdating = True
    End With
End If
End Sub

موفق باشید میر

[M_ExceL]

سلام،
با تشکر از استاد بزرگوار جناب میر عزیز، البته باز هم موردی که ایشون مطرح فرمودند حل نشده است،
لذا کد زیر رو هم تست بفرمایید :

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = Range("c5").Address Then
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
            Dim rng, lrang As Range
            lr = Sheets(2).Cells(Rows.Count, 2).End(3).Row
            Set lrang = Sheets(2).Range("b3:b" & lr)
                        For Each rng In lrang
                            If Range("c5") = rng Then
                            Sheets(2).Cells(lr + 1, 1) = Sheets(1).Range("c3")
                                    For i = 2 To 6
                                        Sheets(2).Cells(lr + 1, i) = rng.Offset(, i - 2)
                                    Next i
                                .EnableEvents = True
                                .ScreenUpdating = True
                                 Range("C3,C5,C7,C9,C11,C13").ClearContents
                                 MsgBox Chr(199) & Chr(216) & Chr(225) & Chr(199) & _
                                 Chr(218) & Chr(199) & Chr(202) & Chr(32) & Chr(200) & _
                                 Chr(199) & Chr(32) & Chr(227) & Chr(230) & Chr(221) & _
                                 Chr(222) & Chr(237) & Chr(202) & Chr(32) & Chr(203) & _
                                 Chr(200) & Chr(202) & Chr(32) & Chr(144) & Chr(209) & _
                                 Chr(207) & Chr(237) & Chr(207)
                            Exit Sub
                            End If
                        Next rng
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End If
End Sub

یا حق.

[12345678910]

سلام وعرض ادب

از هردوی شما استادان بزرگوار جناب آقای میر و آقای M.Excel واقعا ممنون وسپاسگذارم.مشکلم برطرف شد.