وبلاگ

در این راهنمای جامع، یاد می‌گیرید چگونه با استفاده از VBA در اکسل، داده‌های چندین شیت را به صورت خودکار در یک شیت واحد ادغام کنید.

مقدمه

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

ادغام گزارش‌های فروش با استفاده از VBA

برای مثال، فرض کنید دو واحد فروش داریم:

واحد الف

واحد ب

هدف از ادغام

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

مراحل ایجاد ماکرو در VBA

1. وارد منوی Developer شوید و گزینه Visual Basic را انتخاب کنید. اطلاعات بیشتر درباره نحوه فعال کردن منوی Developer را می‌توانید در صفحه چگونه سربرگ توسعه دهنده را در اکسل فعال نمایم؟ مشاهده نمایید.
2. از منوی Insert، گزینه Module را انتخاب کنید تا یک ماژول جدید ایجاد شود. آموزش تصویری نحوه افزودن ماژول استاندارد در VBA را می‌توانید در صفحه ماژول در VBA مشاهده نمایید.

مراحل قدم به قدم ایجاد کد ادغام صفحات در VBA

در ادامه کد را تکه‌تکه بررسی می‌کنیم تا عملکرد هر بخش مشخص شود.

1. اعلان متغیرهای موردنیاز

Dim ws As Worksheet ' متغیر برای هر شیت
Dim wsMaster As Worksheet ' شیت مقصد برای ادغام داده‌ها
Dim rng As Range ' محدوده‌ای که از هر شیت کپی می‌شود
Dim lastRow As Long, lastCol As Long
Dim pasteRow As Long

در این بخش، تمام متغیرهای موردنیاز برای اجرای ماکرو تعریف شده‌اند.

2. مدیریت خطاها و آماده‌سازی شیت مقصد

On Error Resume Next
Set wsMaster = ThisWorkbook.Sheets("MergedData")
If wsMaster Is Nothing Then Set wsMaster = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)) wsMaster.Name = "MergedData"
Else wsMaster.Cells.Clear wsMaster.Move After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
End If
On Error GoTo 0

• On Error Resume Next باعث می‌شود که در صورت بروز خطا، اجرای کد متوقف نشود.
• اگر شیت مقصد وجود نداشته باشد، ایجاد می‌شود و اگر وجود داشته باشد، ابتدا محتوای آن پاک شده و سپس به آخرین موقعیت در بین شیت‌ها منتقل می‌گردد. در این کد از متغیر wsMaster برای اشاره به شیت مقصد استفاده کرده‌ایم. با استفاده از دستور Set و شیء ThisWorkbook، در مجموعه‌ی Sheets شیتی با نام "MergedData" را به عنوان مرجع این متغیر تعیین می‌کنیم. سپس بررسی می‌کنیم که آیا wsMaster برابر با Nothing است یا خیر؛ اگر برابر با Nothing باشد، یعنی شیت وجود ندارد و باید آن را ایجاد کنیم. در غیر این صورت، شیت از قبل موجود است و باید محتوای آن به‌طور کامل پاک شود.
• اطلاعات بیشتر درباره اشیاء اکسل می‌توانید در صفحه اشیاء‌ اکسل در VBA مشاهده نمایید.

3. تنظیمات ظاهری شیت

wsMaster.Tab.Color = RGB(255, 0, 0)
pasteRow = 1

در این قسمت، رنگ تب شیت مقصد به قرمز تغییر داده شده و متغیر pasteRow برای شروع کپی داده‌ها مقداردهی می‌شود.

4. حلقه ادغام داده‌ها

For Each ws In ThisWorkbook.Sheets If ws.Name <> wsMaster.Name Then lastRow = ws.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row lastCol = ws.Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column Set rng = ws.Range(ws.Cells(1, 1), ws.Cells(lastRow, lastCol)) rng.Copy wsMaster.Cells(pasteRow, 1) pasteRow = wsMaster.Cells(wsMaster.Rows.Count, 1).End(xlUp).Row + 1 End If
Next ws

در این بخش، برای هر شیت به جز شیت مقصد:

• آخرین ردیف و ستون دارای داده پیدا می‌شود.
• محدوده داده‌ها انتخاب و در شیت مقصد کپی می‌شود.
• متغیر pasteRow برای شروع کپی داده‌های شیت بعدی به‌روزرسانی می‌شود.

5. نمایش پیام پایان

MsgBox "تمام شیت‌ها با موفقیت در 'MergedData' ادغام شدند!", vbInformation

بعد از اتمام فرآیند، پیام موفقیت‌آمیز بودن ادغام نمایش داده می‌شود.

ماکروی ادغام صفحات اکسل

کد کامل ادغام شیت‌ها به شکل زیر است:

Sub MergeSheets() Dim ws As Worksheet Dim wsMaster As Worksheet Dim rng As Range Dim lastRow As Long, lastCol As Long Dim pasteRow As Long ' ایجاد یا پاکسازی شیت مقصد On Error Resume Next Set wsMaster = ThisWorkbook.Sheets("MergedData") If wsMaster Is Nothing Then Set wsMaster = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)) wsMaster.Name = "MergedData" Else wsMaster.Cells.Clear wsMaster.Move After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count) End If On Error GoTo 0 ' تنظیم رنگ تب به قرمز wsMaster.Tab.Color = RGB(255, 0, 0) pasteRow = 1 ' حلقه در تمام شیت‌های کتاب کار For Each ws In ThisWorkbook.Sheets If ws.Name <> wsMaster.Name Then ' یافتن آخرین سطر و ستون استفاده شده lastRow = ws.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row lastCol = ws.Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column ' تنظیم محدوده داده‌ها Set rng = ws.Range(ws.Cells(1, 1), ws.Cells(lastRow, lastCol)) ' کپی محدوده به شیت مقصد rng.Copy wsMaster.Cells(pasteRow, 1) ' به‌روزرسانی سطر برای چسباندن بعدی pasteRow = wsMaster.Cells(wsMaster.Rows.Count, 1).End(xlUp).Row + 1 End If Next ws MsgBox "تمام شیت‌ها در 'MergedData' ادغام شدند!", vbInformation
End Sub

فیلم اجرای ماکرو

ویدیوی زیر اجرای ماکرو و نتیجه نهایی در شیت MergedData را نشان می‌دهد:

معرفی محصول پیشرفته ادغام شیت‌ها

برای ادغام حرفه‌ای‌تر، ماکروی پیشرفته‌تری با قابلیت‌های زیر توسعه داده‌ایم:

• ادغام گزارشات با ساختار یکسان از چندین فایل اکسل
• افزودن ستون منبع برای شناسایی واحد مبدا داده‌ها
• محاسبه خودکار جمع‌های فرعی (Subtotal)
• پشتیبانی از فرمت‌های تاریخ مختلف
• گزارش خطاهای احتمالی

این ابزار برای مدیران فروش و تحلیلگران داده بسیار کاربردی است و تا 90% در زمان شما صرفه‌جویی می‌کند.

دعوت به تعامل در نظرات

شما هم می‌توانید تجربه خود را در بخش نظرات به اشتراک بگذارید و سوالات خود را درباره VBA و ادغام شیت‌ها بپرسید. پاسخگوی شما هستیم!

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