|
🖤 پیام تسلیتبا نهایت تأسف و تأثر، باخبر شدیم جناب آقای محمد محمدی با نام کاربری smartman ، از مدیران ارزشمند انجمن اکسل ایران، دار فانی را وداع گفتهاند. ایشان سالها با دانش، تجربه، اخلاق نیکو و روحیه کمک به دیگران، سهم بزرگی در رشد و پویایی انجمن داشتند و خاطره حضور ارزشمندشان همواره در ذهن اعضای انجمن باقی خواهد ماند. مدیریت و اعضای انجمن ExcelIran این ضایعه را به خانواده محترم ایشان، دوستان و تمامی اعضای انجمن تسلیت عرض نموده و از خداوند متعال برای آن مرحوم، رحمت و مغفرت الهی و برای بازماندگان صبر و شکیبایی مسئلت دارند.
انا لله و انا الیه راجعون
|
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Dim i, Z1 As Integer, blnFound As Boolean, xx As String
Dim list1 As New Collection
Set list1 = Nothing
y = Sheet1.Cells(Sheet1.Rows.Count, "A").End(xlUp).Row
On Error Resume Next
For i = 2 To y
xx = Range("A" & i)
If Len(xx) > 0 Then
list1.Add xx, CStr(xx)
End If
Next
With ThisWorkbook
For j = 1 To list1.Count
blnFound = False
For i = 1 To .Sheets.Count
If .Sheets(i).Name = list1.Item(j) Then
blnFound = True
Sheets(i).Move Before:=Sheets(j + 1)
End If
Next i
If blnFound = False Then
.Sheets.Add after:=Sheets(Sheets.Count)
With ActiveSheet
.Name = list1.Item(j)
End With
End If
Next j
End With
'===== sheets sort ==========='
With ThisWorkbook
For i = 2 To .Sheets.Count
For j = 1 To list1.Count
If .Sheets(i).Name = list1.Item(j) Then
Sheets(i).Move Before:=Sheets(j + 1)
End If
Next j
Next i
End With
'===== sheets sort ==========='
Application.ScreenUpdating = True
Sheet1.Select
End Sub
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Dim i, Z1 As Integer, blnFound As Boolean, xx As String
Dim list1 As New Collection
Set list1 = Nothing
y = Sheet1.Cells(Sheet1.Rows.Count, "A").End(xlUp).Row
On Error Resume Next
For i = 2 To y
xx = Range("C" & i)
If Len(xx) > 0 Then
list1.Add xx, CStr(xx)
End If
Next
With ThisWorkbook
For J = 1 To list1.Count
blnFound = False
For i = 1 To .Sheets.Count
If .Sheets(i).Name = list1.Item(J) Then
blnFound = True
Sheets(i).Move Before:=Sheets(J + 1)
End If
Next i
If blnFound = False Then
.Sheets.Add after:=Sheets(Sheets.Count)
With ActiveSheet
.Name = list1.Item(J)
ActiveSheet.DisplayRightToLeft = True
End With
End If
Next J
End With
'===== sheets sort ==========='
With ThisWorkbook
For i = 1 To .Sheets.Count
For J = 1 To list1.Count
If .Sheets(i).Name = list1.Item(J) Then
blnFound = True
Sheets(i).Move Before:=Sheets(J + 1)
End If
Next J
Next i
End With
'===== sheets sort END ==========='
'==== DATA COPY TO SHEET ============='
Dim list2 As New Collection
y = Sheet1.Cells(Sheet1.Rows.Count, "A").End(xlUp).Row
For J = 2 To Sheets.Count
Set list2 = Nothing
For i = 2 To y
xx = Range("C" & i)
If xx = Sheets(J).Name Then
list2.Add Range("C" & i).Row
End If
Next
K = 2
YY = Sheets(J).Name
Range("A1:C1").Copy Destination:=Sheets(YY).Range("A1")
For i = 1 To list1.Count
Range("A" & list2.Item(i) & ":C" & list2.Item(i)).Copy Destination:=Sheets(YY).Range("A" & K)
K = K + 1
Next
Next
Sheet1.Select
Application.ScreenUpdating = True
End Sub
کامنت