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
کامنت