جدا کردن یک شیت به چند شیت بر اساس اطلاعات یک ستون 2
' @mas76nrm 2023/11/26
Private Function WorksheetExists(shtName As String, Optional wb As Workbook) As Boolean
Dim sht As Worksheet
If wb Is Nothing Then Set wb = ThisWorkbook
On Error Resume Next
Set sht = wb.Sheets(shtName)
On Error GoTo 0
WorksheetExists = Not sht Is Nothing
End Function
'Function WorksheetExists(sName As String) As Boolean
' WorksheetExists = Evaluate("ISREF('" & sName & "'!A1)")
'End Function
'Private Function getCity(cityPersianName As String)
' Dim cities As Variant
' cities = Array( _
' Array("مرکز استان", "Center"), _
' Array("اردب?ل", "Ardabil"), _
' Array("پارس آباد", "Parsabad"), _
' Array("بيله سوار", "BileSavar") _
' )
' Dim i As Integer
' getCity = "test"
' For i = 0 To 3
' If cities(i)(0) = cityPersianName Then
' getCity = cities(i)(1)
' Exit For
' End If
' Next i
'End Function
Private Function copyRow(sourceSheet As String, destinationSheet As String, rowNumber As Integer, Optional increaseRow As Boolean = False)
Dim ws1 As Worksheet, ws2 As Worksheet
Dim lastRow As Long
Set ws1 = ThisWorkbook.Sheets(sourceSheet)
Set ws2 = ThisWorkbook.Sheets(destinationSheet)
lastRow = ws2.Cells(Rows.Count, "A").End(xlUp).Row
If increaseRow Then
lastRow = lastRow + 1
End If
ws1.Rows(rowNumber).EntireRow.copy ws2.Range("A" & lastRow)
copyRow = True
End Function
Public Sub extractCities()
Dim rowCounter As Integer
Dim city As String
Dim res As Boolean
ThisWorkbook.Sheets("Personels").Select
For rowCounter = 3 To 1000
city = Cells(rowCounter, 8).Value
If WorksheetExists(city) Then
Application.DisplayAlerts = False
ThisWorkbook.Sheets(city).Delete
Application.DisplayAlerts = True
End If
Next rowCounter
For rowCounter = 3 To 1000
ThisWorkbook.Sheets("Personels").Select
city = Cells(rowCounter, ThisWorkbook.Sheets("Personels").Cells(1, 5)).Value
If Not IsNull(city) And city <> "" Then
If Not WorksheetExists(city) Then
With ThisWorkbook
.Sheets.Add(After:=.Sheets(.Sheets.Count)).Name = city
.Sheets(.Sheets.Count).DisplayRightToLeft = True
End With
res = copyRow("Personels", city, 2)
End If
res = copyRow("Personels", city, rowCounter, True)
End If
Next rowCounter
MsgBox "Finished"
End Sub
Count Unique Values In A Filtered Column With Array Formula
Bring handy tabs to Excel and other Office software, just like Chrome, Firefox and new Internet Explorer.
بسیاری از دوستان برای دانلود از سایت رپید شیر مشکلات فراوانی دارند که مهمترین آن عدم امکان دانلود در فواصل زمانی ، یعنی اگر در حال دانلود باشند و ارتباط قطع شود هرچه دانلود کرده اند به باد رفته!!! البته این مشکل در صورتی هست که شما به صورت رایگان از سایت رپیدشیر دانلود کنید اما اگر از پرمیوم یا همون پولی استفاده کنید چنین مشکلی ندارید... چند لینک رو در یک زمان هم می تونید دانلود کنید،به طور پیش فرض 2لینک قابل دانلود هست که شما می تونید در تنظیمات اون رو افزایش بدید...
نکته ی نخست برای بدست آوردن بهترین نتیجه ها این است که بدانید شما بدنبال چه چیزی هستید. شاید شما بدنبال یک کلمه یا یک جمله باشید که در سایت مقصد به کار نرفته باشد. اگر نتیجه ی دلخواه حاصل نشد باید از نزدیکترین کلمه ها و جمله ها به مورد جستجو استفاده کرد. مانند این مثال : شما بدنبال توضیحاتی در مورد تلفون های بی سیم میگردید با جستجوی عبارت “comparative review of wireless phones” این امکان وجود دارد که با این ترکیب کلمه ها به هدف نرسید، پس از عبارت هایی مثل SmartPhone, Audiovox, Motorola استفاده میکنیم. خواهید دید که نتیجه ها خیلی بیشتر به هدف شما نزدیک شده اند.
دانلود موزیک روز کامپیوتر جوک و sms اس ام اس مطالب جالب