کد:
Public Sub Getdata()
On Error GoTo err
Dim path As String
Dim sheetName As String
Dim wb As Workbook
Dim wsh As Worksheet
Dim rngInsert As Range
Dim rngCriteria1 As Range
Dim rngCriteria2 As Range
Dim i As Integer
Dim rowStart As Integer
Dim rowEnd As Integer
Dim Criteria3 As String
path = Sheet5.Range("w3").Value
sheetName = Sheet5.Range("w4").Value
Criteria3 = Sheet5.Range("G7").Value
rowEnd = Sheet5.Range("p5").Value
rowStart = 9
i = 1
Application.ScreenUpdating = False
Set wb = Workbooks.Open(path)
Set wsh = wb.Sheets(sheetName)
Set rngInsert = Sheet5.Range("T" & rowStart & ":T" & rowEnd)
Set rngCriteria1 = Sheet5.Range("D" & rowStart & ":D" & rowEnd) 'شرح
Set rngCriteria2 = Sheet5.Range("E" & rowStart & ":E" & rowEnd) 'سايز
For Each row In rngInsert
row.Value = WorksheetFunction.SumIfs(wsh.Range("J:J"), wsh.Range("C:C"), rngCriteria1(i), wsh.Range("D:D"), rngCriteria2(i), wsh.Range("F:F"), Criteria3)
i = i + 1
Next row
Dim x As Variant
x = Application.WorksheetFunction.Filter(wsh.Range("C:K"), wsh.Range("F:F") = "MPL2") 'اين خط کد کار نمي کند
MsgBox Join(Application.Transpose(x), vbNewLine)
wb.Close
err:
Exit Sub
MsgBox err.Description, vbCritical, "error"
End Sub
علاقه مندی ها (Bookmarks)