انتقال ستون های یک فایل به فایل دیگر به صورت نظیر به نظیر

[ghoghnous]

با عرض سلام و خداقوت خدمت دوستان محترم
سوالی از محضرتون داشتم که به صورت زیر مطرح میکنم:
بنده یک فایل حقوق و دستمزد رو از نرم افزار حقوق و دستمزد همکاران سیستم به اکسل اکسپرت میکنم. که از یک سری فیلد تشکیل شده. این فیلدها رو در ابتدای امسال بصورت سرت شده و مرتب شده درآوردم. با توجه به اینکه تغییراتی در سیستم حقوق و دستمزد اتفاق افتاده است ، دیگه به صورت مرتب شده نمیتونم فیلدها رو از این سیستم به اکسل اکسپرت کنم. دنبال راهی هستم که پس از اکسپرت فایل به اکسل با یک تابعی ، فرمولی و یا .... این فیلدها رو متناظر با فیلدهای حقوق ماه های گذشته که سرت شده است بهمراه اطلاعات مربوط به خودش یکجا برام بیاره. ممنون از راهنمایی شما

اخطار: این یک موضوع قدیمی است به دلیل قدیمی بودن موضوع، ممکن است برخی فایل های ضمیمه به درستی کار نکنند. لطفا در صورت عدم ضرورت، از بالا آوردن موضوعات قدیمی خودداری نمایید.

[iranweld]

با سلام

لطفا یک نمونه فایل در سایت ضمیمه کنید که مشکل شما در آن مشخص شده باشد

[ghoghnous]

با سلام

لطفا یک نمونه فایل در سایت ضمیمه کنید که مشکل شما در آن مشخص شده باشد

سلام، به پیوست فایل خدمتتان ارسال میگردد.

[iranweld]

با سلام

ماکرو ذیل را تست بفرمایید

Sub test()
k1 = Application.WorksheetFunction.CountA(Sheet1.Range("1:1")) 
k2 = Application.WorksheetFunction.CountA(Sheet2.Range("1:1")) 

For i = 1 To k1
For j = 1 To k2

If Sheet1.Cells(1, i).Value = Sheet2.Cells(1, j).Value Then

If i <> j Then

Sheet2.Columns(j).Cut
Sheet2.Columns(i).Select
Selection.Insert Shift:=xlToRight

Else

End If
End If

Next
Next

Sheet2.Range("a1").Select



End Sub 

[mokaram]

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

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

برای قسمت دوم هم با ضبط یک ماکرو این امکان فراهم میشه

[amshahbazikl]

با سلام
این کار با چند خط کد به سادگی قابل حل است.
فایل پیوست را ببینید

[ghoghnous]

با عرض سلام و خداقوت خدمت مدیر محترم انجمن
طبق فرموده جنابعالی که کاملاً هم درست می باشد ، بنده تا ماه گذشته این کار را انجام میدادم ولی با توجه به حجیم بود اطلاعات و زمانبر بودن آن در پی راه حل ساده تری جهت حل این معضل بودم. با تشکر فراوان.

[ghoghnous]

با سلام

ماکرو ذیل را تست بفرمایید

Sub test()
k1 = Application.WorksheetFunction.CountA(Sheet1.Range("1:1")) 
k2 = Application.WorksheetFunction.CountA(Sheet2.Range("1:1")) 

For i = 1 To k1
For j = 1 To k2

If Sheet1.Cells(1, i).Value = Sheet2.Cells(1, j).Value Then

If i <> j Then

Sheet2.Columns(j).Cut
Sheet2.Columns(i).Select
Selection.Insert Shift:=xlToRight

Else

End If
End If

Next
Next

Sheet2.Range("a1").Select



End Sub 

با عرض سلام و خسته نباشید
در هنگام اجرای ماکرو در قسمت Sheet2.Range("a1").Select ارور میدهد

[ghoghnous]

با سلام
این کار با چند خط کد به سادگی قابل حل است.
فایل پیوست را ببینید

با عرض سلام و احترام
ماکرویی که لطف فرمودید فقط جای برخی فیلدها را تغییر میدهد و به صورت استاندارد تبدیل نمی کند.

[iranweld]

فیلدهای ردیف و ماه و .... دقیقا با شیت اول یکسان میگردد حال به صورت استاندارد چگونه هستش؟

فقط انتقال به شیت اول ماکروش در دست تهیه میباشد

===================================

ماکرو فوق در فایل پیوست لحاظ گردید