|
🖤 پیام تسلیتبا نهایت تأسف و تأثر، باخبر شدیم جناب آقای محمد محمدی با نام کاربری smartman ، از مدیران ارزشمند انجمن اکسل ایران، دار فانی را وداع گفتهاند. ایشان سالها با دانش، تجربه، اخلاق نیکو و روحیه کمک به دیگران، سهم بزرگی در رشد و پویایی انجمن داشتند و خاطره حضور ارزشمندشان همواره در ذهن اعضای انجمن باقی خواهد ماند. مدیریت و اعضای انجمن ExcelIran این ضایعه را به خانواده محترم ایشان، دوستان و تمامی اعضای انجمن تسلیت عرض نموده و از خداوند متعال برای آن مرحوم، رحمت و مغفرت الهی و برای بازماندگان صبر و شکیبایی مسئلت دارند.
انا لله و انا الیه راجعون
|
Sub M_ExceL()
Dim lstr As Long
Dim r, i, l As Long
Dim c As Boolean
Range(Cells(2, 6), Cells(Rows.Count, 6)).ClearContents
Range(Cells(2, 5), Cells(Rows.Count, 5)).ClearContents
lstr = Cells(Rows.Count, 1).End(3).Row
r = 2
Application.ScreenUpdating = False
For i = 2 To lstr
l = 2
c = False
If Mid(Cells(i, 1), 1, 1) = "(" Then
Do While Mid(Cells(i, 1), l, 1) <> ")" Or l = Len(Cells(i, 1))
If Not IsNumeric(Mid(Cells(i, 1), l, 1)) Then
c = False
Exit Do
Else
c = True
End If
l = l + 1
Loop
End If
If c = True Then
Cells(r, 5) = r - 1
Cells(r, 6) = Cells(i, 1)
r = r + 1
End If
Next
Application.ScreenUpdating = True
End Sub
.png "min17")
Sub M_ExceL()
Dim A() As String
Dim M As Variant
Dim r, i, lstr As Long
ActiveSheet.AutoFilterMode = False
lstr = Cells(Rows.Count, 1).End(3).Row
M = Array("(#)", "(##)", "(###)", "#-", "#)-")
r = 1
For i = 1 To lstr
For Each itm In M
If Left(Cells(i, 1), 6) Like "*" & itm & "*" _
And Len(Cells(i, 1)) > 5 Then
ReDim Preserve A(1 To r)
A(r) = Cells(i, 1)
r = r + 1
End If
Next
Next
Range("a1:a" & lstr).AutoFilter
Range("a1:a" & lstr).AutoFilter Field:=1, Criteria1:=A, _
Operator:=xlFilterValues
End Sub
کامنت