[حل شده] تبدیل جدول ماتریسی به خطی بر اساس یک id خاص

[m.zamani]

سلام و روز بخیر
من یک جدول بسیار بزرگ دارم از سوابق آموزشی افراد ( با id کد پرسنلی) که به ازای هر نفر بارها تکرار شده، یعنی یک کد پرسنلی بارها تکرار شده ولی اطلاعات یکسان نیستند. میخوام با استفاده از VLOOKUP یا HLOOKUP این داده ها بر اساس کد پرسنلی پیدا شده و توی یک جدول دیگه قرار داده شوند.
احتمالال برای این کار لازمه تمام داده ها به صورت سطری روبروی هم قرار بگیرند تا دسترسی بهشون برای فرمول نویسی از ظریق شماره ستون ها امکان پذیر باشه.. فایل های نمونه رو پیوست میکنم. اگر حتی بتونین خیلی خلاصه هم راهنمایی بفرمایید خیلی ممنون میشم چون برای این داده ها رو خیلی زود نیاز دارم.

با تشکر مجدد
زمانی

[امين اسماعيلي]

ba drod farz avalie hale in moshkel be raveshe man , in jor hastesh ke to data base shoma , code pesoneli ha poshte sare ham hasesh , yani shoma az kochik be bozorg ya belaxe sorteshon kardi
hal ba tavago be in maghole bebin in rahe hal monasebe, ya na

[امين اسماعيلي]

ba drod agar file ghablio baz kardi be eror khordi tajob nakonia, chon address file ha to system mano shomo fargh mikone
ama ravesh badi ba vba hast man to filet piadash nemikonam ama testesh kardamo javab dade , code haro mizaram , zahmate gozahstanesh to file khodeton ba shoma


avakl file Report-Sample ro baz mikonin

ye CommandButton vasash mizari, omidvaram in kararo balad bashi vagar na, khaheshan , be bakhshe vba moraje kon va ya jozavate amozeshi hamin site ke az hamon ebteda be sorate bonyadi in masaelo yad begiri

codce zire ro vase clide morede nazar mizari

Application.ScreenUpdating = False
Application.EnableEvents = False

Dim LastRow, lastrow2 As Long

 ' check if the personel ID is entered
If Sheet5.Range("C2").Value = "" Then
MsgBox "Please enter your personel ID first", vbCritical
Sheet5.Range("C2").Select
Exit Sub
End If
' clear previous data
If WorksheetFunction.CountA(Cells) > 0 Then
       'Search for any entry, by searching backwards by Rows.
        LastRow = Sheet5.Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    End If
If Sheet5.Range("B13").Value <> "" Then
    Sheet5.Range("B13:D" & LastRow).Value = ""
    End If
' check if the database report workbook is open or not
If WorkbookOpen("Report-Sample.xlsx") = False Then
MsgBox "your database workbook is not open"
Exit Sub
End If

' get the last used cell in your database workbook inorder to increase the speed of search
 lastrow2 = Workbooks("Report-Sample.xlsx").Sheets("sheet1").Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
' register the information
Dim c As Range
Dim i
i = 1
For Each c In Workbooks("Report-Sample.xlsx").Sheets("sheet1").Range("A2:A" & lastrow2)
If c.Value = Sheet5.Range("C2").Text Then
Sheet5.Range("B12").Offset(i, 0).Value = c.Offset(0, 5)
Sheet5.Range("B12").Offset(i, 1).Value = c.Offset(0, 6)
Sheet5.Range("B12").Offset(i, 2).Value = c.Offset(0, 7)
i = i + 1
End If
Next c

Application.ScreenUpdating = True
Application.EnableEvents = True

badesh ye module misazi, sakht nisa, az tarighe vba, insert , module hamin, va code zire ro to module ijad shode mizari

Function WorkbookOpen(WorkBookName As String) As Boolean
' returns TRUE if the workbook is open
WorkbookOpen = False
On Error GoTo WorkBookNotOpen
If Len(Application.Workbooks(WorkBookName).Name) > 0 Then
WorkbookOpen = True
Exit Function
End If
WorkBookNotOpen:
End Function

tozihate khotote code ham gozashte shode, lazem nist ke etelate personel moratab bashe, faghat yadet bashe ke hardo file baz bashan, harchand agar baz nabashan , code ha ye payam midan ke file data base shoma baz nist. dar zemn format addadi code personeliton irad dare. yani man daghighan copy mikardam va mizashtam to reporteton

dar akhar ham mahi girio yad begir . az dostane aziz ham khaheshan, file nemone gharar nadin. bezarin bache ha fundamental vba ro khob yad begiran hade aghal

[امين اسماعيلي]

[m.zamani]

[ATTACH=CONFIG]11006[/ATTACH][ATTACH=CONFIG]11007[/ATTACH]

دوست و استاد بسیار بسیار گرامی

سلام
با روش اول مسئله حل شد. خیلی خیلی خیلی ازتون ممنونم.. واقعا فکر نمی کردم تو روز تعطیلی بتونم جواب بگیرم..
باز هم ازتون تشکر می کنم..

[Amir Ghasemiyan]

دوست و استاد بسیار بسیار گرامی

سلام
با روش اول مسئله حل شد. خیلی خیلی خیلی ازتون ممنونم.. واقعا فکر نمی کردم تو روز تعطیلی بتونم جواب بگیرم..
باز هم ازتون تشکر می کنم..

دوست عزیز لطف کنید تاپیک رو حل شده کنید

[aliakbarranjbar]

دوست عزیز لطف کنید تاپیک رو حل شده کنید

سلام، شرمنده ببخشید چطور میشه روی فایل اکسل پسورد گذاشت؟

Sent from my C6603 using Tapatalk

[Amir Ghasemiyan]

سلام، شرمنده ببخشید چطور میشه روی فایل اکسل پسورد گذاشت؟

Sent from my C6603 using Tapatalk

سلام
لطفا برای سوالات خود اول سرچ کنید اگر پیدا نکردین تاپیک مجزا بزنید دوست عزیز

[aliakbarranjbar]

سلام
لطفا برای سوالات خود اول سرچ کنید اگر پیدا نکردین تاپیک مجزا بزنید دوست عزیز

گشتم نبود

Sent from my C6603 using Tapatalk

[Amir Ghasemiyan]

گشتم نبود

Sent from my C6603 using Tapatalk

خب پس تاپیک ایجاد کنید دوست عزیز

درضمن:
آموزش پسورد گذاري بر روي فايل اكسل 2007

پسورد گذاشتن بر روی شیتها

[aliakbarranjbar]

خب پس تاپیک ایجاد کنید دوست عزیز

درضمن:
آموزش پسورد گذاري بر روي فايل اكسل 2007

پسورد گذاشتن بر روی شیتها

دست شما درد نکند

Sent from my C6603 using Tapatalk