جستجو

ترفندهای کامپیوتری

حضرت علی (ع): «زَکوةُ العِلمِ نَشرُهُ؛ زکات علم نشر آن است».
وبلاگ "ترفندها" (سایت پی‌سی‌ترفند) برای عمل به این حدیث شریف و با هدف ارتقاء دانش و مهارت‌های مرتبط با رایانه در ۳۰ مهرماه ۱۳۹۱ ایجاد شده است. به امید آنکه مفید واقع شود.
ربات پی‌سی‌ترفند در تلگرام:
telegram.me/pctarfand_bot

خلاصه آمار

تبليغات

پربحث ترين ها

۱

تفکیک اطلاعات یک جدول در شیت‌های مختلف در اکسل

اکسل ماکرونویسی

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

در واقع آنچه که می‌خواهیم انجام دهیم در تصویر زیر نشان داده شده است:

روش ۱) ماکرونویسی

  

کلیدهای Alt + F11 را فشار دهید یا از تب Developer قسمت code گزینه Visual Basic را انتخاب کنید. پنجره Microsoft Visual Basic ظاهر می‌شود. در این پنجره از تب Insert گزینه Module را انتخاب نمائید.

در پنجره جدید باز شده کدهای زیر را کپی کنید.

Sub Parse_data()
'pctarfand.ir & tarfandha.blog.ir'
Dim lr As Long
Dim ws As Worksheet
Dim vcol, i As Integer
Dim icol As Long
Dim myarr As Variant
Dim title As String
Dim titlerow As Integer
vcol = 1
Set ws = Sheets("Sheet1")
lr = ws.Cells(ws.Rows.Count, vcol).End(xlUp).Row
title = "A1:C1"
titlerow = ws.Range(title).Cells(1).Row
icol = ws.Columns.Count
ws.Cells(1, icol) = "Unique"
For i = 2 To lr
On Error Resume Next
If ws.Cells(i, vcol) <> "" And Application.WorksheetFunction.Match(ws.Cells(i, vcol), ws.Columns(icol), 0) = 0 Then
ws.Cells(ws.Rows.Count, icol).End(xlUp).Offset(1) = ws.Cells(i, vcol)
End If
Next
myarr = Application.WorksheetFunction.Transpose(ws.Columns(icol).SpecialCells(xlCellTypeConstants))
ws.Columns(icol).Clear
For i = 2 To UBound(myarr)
ws.Range(title).AutoFilter field:=vcol, Criteria1:=myarr(i) & ""
If Not Evaluate("=ISREF('" & myarr(i) & "'!A1)") Then
Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = myarr(i) & ""
Else
Sheets(myarr(i) & "").Move after:=Worksheets(Worksheets.Count)
End If
ws.Range("A" & titlerow & ":A" & lr).EntireRow.Copy Sheets(myarr(i) & "").Range("A1")
Next
ws.AutoFilterMode = False
ws.Activate
End Sub

در کد فوق:

در قسمت vcol =1، عدد جلوی = نشان‌دهنده شماره ستونی است که شما می‌خواهید براساس آن اطلاعات را تفکیک کنید که در مثال ما ستون شماره 1 است.

در قسمت ("Set ws = Sheets("Sheet1، عبارت بین دو " " نشان‌دهنده نام کاربرگی (شیت) است که شما می‌خواهید اطلاعات آن را تفکیک کنید که در مثال ما Sheet1 است.

در قسمت "title = "A1:C1، عبارت بین دو " " نشان‌دهنده محدوده عنوان ستون‌ها است که در مثال ما ردیف اول یعنی A1:C1 است.

پس از اصلاح موارد فوق می‌توانید کد ماکرو را اجرا کنید، برای اینکار دکمه doc-multiply-calculation-3 یا کلید F5 را فشار دهید تا کد اجرا شود. نتیجه زیر حاصل می‌شود.

منبع: extendoffice.com

  • کدهای دیگر:

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

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

Sub Split_Data_Into_Multiple_Worksheets()
'pctarfand.ir & tarfandha.blog.ir'
Dim lr As Long
Dim ws As Worksheet
Dim vcol, i As Integer
Dim icol As Long
Dim myarr As Variant
Dim title As Range 'String
Dim titlerow As Integer
Dim lngLastCol As Long
Dim strLastCol As String
vcol = Application.InputBox("Enter the column number used for splitting", "Select column", 1, , , , , 1)
   If vcol = 0 Then Exit Sub
Set ws = ActiveWorkbook.ActiveSheet
lr = ws.Cells(ws.Rows.Count, vcol).End(xlUp).Row
'new
lngLastColumn = Cells.Find("*", SearchOrder:=xlByColumns, LookIn:=xlValues, SearchDirection:=xlPrevious).Column
strLastCol = Split(Cells(1, lngLastColumn).Address, "$")(1)
'title = "A1:L1" 'HARD CODED. Should be DYNAMIC
Set title = Application.InputBox("Please enter the Title range", "Select Title Range", "A1:" & strLastCol & "1", Type:=8)
If title Is Nothing Then Exit Sub
'titlerow = ws.Range(title).Cells(1).Row
titlerow = title.Row
icol = ws.Columns.Count
ws.Cells(1, icol) = "Unique"
For i = 2 To lr
On Error Resume Next
If ws.Cells(i, vcol) <> "" And Application.WorksheetFunction.Match(ws.Cells(i, vcol), ws.Columns(icol), 0) = 0 Then
ws.Cells(ws.Rows.Count, icol).End(xlUp).Offset(1) = ws.Cells(i, vcol)
End If
Next
myarr = Application.WorksheetFunction.Transpose(ws.Columns(icol).SpecialCells(xlCellTypeConstants))
ws.Columns(icol).Clear
For i = 2 To UBound(myarr)
'ws.Range(title).AutoFilter field:=vcol, Criteria1:=myarr(i) & ""
ws.Range(title.Rows(1).Address).AutoFilter field:=vcol, Criteria1:=myarr(i) & ""
If Not Evaluate("=ISREF('" & myarr(i) & "'!A1)") Then Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = myarr(i) & ""
Sheets(myarr(i) & "").Move after:=Worksheets(Worksheets.Count)
ws.Range("A" & titlerow & ":A" & lr).EntireRow.Copy Sheets(myarr(i) & "").Range("A1")
'Sheets(myarr(i) & "").Columns.AutoFit
Next
ws.AutoFilterMode = False
ws.Activate
End Sub

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

در کادر دومی که باز می‌شود محدوده عنوان ستون‌ها را باید وارد کنید که در مثال ما ردیف اول یعنی A1:C1 است.

منبع با تغییر: experts-exchange.com

کدهای دیگری نیز در اینجا و اینجا ارائه شده است.


روش ۲) با استفاده از افزونه‌

  • افزونه Kutools for Excel

نحوه دانلود و استفاده از این افزونه را می‌توانید در اینجا و اینجا مشاهده کنید.

 

  • افزونه DataPig Excel Explosion

این افزونه باید خریداری شود.

نحوه دانلود و استفاده از این افزونه را می‌توانید در اینجا مشاهده کنید.

 

عضویت در خبرنامه:

نظرات (۱)

  1. سلام و عرض خسته نباشید
    مثل همیشه بسیار عالی و کاربردی
    تشکر فراوان

ارسال نظر

قبل از ارسال نظر به نکات زیر توجه کنید:

۱- با توجه با اینکه نظرات خصوصی شما امکان نمایش در سایت را ندارد، بنابراین هنگام ارسال نظر، گزینه "" را انتخاب نکنید. چون تنها راه پاسخگویی به آن از طریق ایمیل شما است که با توجه به مشغله کاری فرصت ارسال پاسخ از طریق ایمیل وجود ندارد.

۲- قبل از مطرح کردن سوالتان، مطلب فوق را با دقت مطالعه کنید. اگر پاسخ سوالتان را پیدا نکردید در سایت جستجو کنید، ممکن است در مطلب دیگر پاسخ سوالتان را پیدا کنید.

۳- تنها به سوالاتی پاسخ داده می‌شود که از نحوه حل آن‌ها اطلاع داشته باشم.

۴- نظراتی با مضمون زیر، صرفا تایید و نمایش داده می‌شود و به آن‌ها پاسخی داده نمی‌شود.

الف) در مورد پاسخ سوال شما اطلاعی نداشته باشم،

ب) پاسخ سوال شما در مطلب فوق وجود داشته باشد.

ارسال نظر آزاد است، اما اگر قبلا در بیان ثبت نام کرده اید می توانید ابتدا وارد شوید.
شما میتوانید از این تگهای html استفاده کنید:
<b> یا <strong>، <em> یا <i>، <u>، <strike> یا <s>، <sup>، <sub>، <blockquote>، <code>، <pre>، <hr>، <br>، <p>، <a href="" title="">، <span style="">، <div align="">
تجدید کد امنیتی
X بستن