|
🖤 پیام تسلیتبا نهایت تأسف و تأثر، باخبر شدیم جناب آقای محمد محمدی با نام کاربری smartman ، از مدیران ارزشمند انجمن اکسل ایران، دار فانی را وداع گفتهاند. ایشان سالها با دانش، تجربه، اخلاق نیکو و روحیه کمک به دیگران، سهم بزرگی در رشد و پویایی انجمن داشتند و خاطره حضور ارزشمندشان همواره در ذهن اعضای انجمن باقی خواهد ماند. مدیریت و اعضای انجمن ExcelIran این ضایعه را به خانواده محترم ایشان، دوستان و تمامی اعضای انجمن تسلیت عرض نموده و از خداوند متعال برای آن مرحوم، رحمت و مغفرت الهی و برای بازماندگان صبر و شکیبایی مسئلت دارند.
انا لله و انا الیه راجعون
|
Private Sub Worksheet_Change(ByVal Target As Range)
Dim TName, rowNum, i, j As Integer
Dim AA As String
'
'
AA = Target.Address
If AA = "$A$2" Then
Dim sht As Worksheet
Dim tbl As ListObject
'
Set sht = Application.ActiveWorkbook.Worksheets("اطلاعات فروش کالا")
Set tbl = sht.ListObjects.Item("Table5")
'
If Target.Count > 1 Then GoTo exitHandler
On Error Resume Next
TName = Target.Value
Application.EnableEvents = False
With Application.WorksheetFunction
For i = 11 To .CountA(Range("A11:A1000")) + 11 Step 1
For j = 1 To 8 Step 1
Cells(i, j).ClearContents
Next
Next
rowNum = .CountIf(tbl.ListColumns.Item(7).DataBodyRange, TName)
If rowNum = 0 Then GoTo exitHandler
'
j = 11
For i = 1 To tbl.ListRows.Count Step 1
If tbl.Range(i + 1, 7) = TName Then
Cells(j, 1) = tbl.Range(i + 1, 1)
Cells(j, 2) = tbl.Range(i + 1, 2)
Cells(j, 3) = tbl.Range(i + 1, 3)
Cells(j, 4) = tbl.Range(i + 1, 4)
Cells(j, 5) = tbl.Range(i + 1, 5)
Cells(j, 6) = tbl.Range(i + 1, 7)
Cells(j, 7) = tbl.Range(i + 1, 8)
Cells(j, 8) = tbl.Range(i + 1, 9)
j = j + 1
End If
Next
End With
End If
exitHandler:
Application.EnableEvents = True
End Sub
کامنت