[حل شده] ماکروی sumif

[naser1357]

ماکروی فراخوانی اعداد متناظر از شیت های مختلف نوشتم اما وسط کار یک خطایی میده ممنون میشوم بررسی کنند و ماکروی صحیح را برام ارسال فرمایند

Sub sumifs2()
Dim nas As Range
Dim naser As Range
Dim c As Range
Dim d As Range
Dim f As Range
Dim j As Range
Dim l As Range
Dim ab As Range
Dim ac As Range
Dim ae As Range
Dim af As Range


Dim lastrow As Long

With Sheet3
lastrow = Cells(Rows.Count, "a").End(xlUp).Row
End With
Set nas = Sheet3.Range("b3:b10000")
Set naser = Sheet3.Range("a3:a10000")
Set d = Sheet3.Range("d3:d10000")
Set f = Sheet3.Range("f3:f10000")
Set j = Sheet3.Range("j3:j10000")
Set l = Sheet3.Range("l3:l10000")
Set ab = Sheet3.Range("ab3:ab10000")
Set ac = Sheet3.Range("ac3:ac10000")
Set ae = Sheet3.Range("AE3:AE10000")
Set af = Sheet3.Range("af3:af10000")


For Each c In Sheet10.Range("a4:a10000")
If c.Offset(0, 0) > "" Then
   
  c.Offset(0, 23) = WorksheetFunction.sumifs(nas, naser, c.Offset(0, 0))
    c.Offset(0, 24) = WorksheetFunction.sumifs(d, naser, c.Offset(0, 0))
  c.Offset(0, 25) = WorksheetFunction.sumifs(f, naser, c.Offset(0, 0))
  c.Offset(0, 26) = WorksheetFunction.sumifs(j, naser, c.Offset(0, 0))
  c.Offset(0, 27) = WorksheetFunction.sumifs(l, naser, c.Offset(0, 0))
  c.Offset(0, 28) = WorksheetFunction.sumifs(ab, naser, c.Offset(0, 0))
  c.Offset(0, 29) = WorksheetFunction.sumifs(ac, naser, c.Offset(0, 0))
  c.Offset(0, 31) = WorksheetFunction.sumifs(af, naser, c.Offset(0, 0))


  End If
          Next
End Sub

[iranweld]

با سلام

کد ذیل را تست کنید

Sub sumifs2()
Dim nas As Range
Dim naser As Range
Dim c As Range
Dim d As Range
Dim f As Range
Dim j As Range
Dim l As Range
Dim ab As Range
Dim ac As Range
Dim ae As Range
Dim af As Range


Dim lastrow As Long

Range("B4:N1800").ClearContents


lastrow = Sheet3.Cells(Sheet3.Rows.Count, "a").End(xlUp).Row

Set naser = Sheet3.Range("a2:a" & lastrow)
Set nas = Sheet3.Range("b2:b" & lastrow)
Set d = Sheet3.Range("d2:d" & lastrow)
Set f = Sheet3.Range("f2:f" & lastrow)
Set j = Sheet3.Range("j2:j" & lastrow)
Set l = Sheet3.Range("l2:l" & lastrow)
Set ab = Sheet3.Range("ab2:ab" & lastrow)
Set ac = Sheet3.Range("ac2:ac" & lastrow)
Set ae = Sheet3.Range("AE2:AE" & lastrow)
Set af = Sheet3.Range("af2:af" & lastrow)

z1 = Cells(Rows.Count, "a").End(xlUp).Row

For Each c In Sheet1.Range("a4:a" & z1)
'If c.Offset(0, 0) = "" Then
   
  c.Offset(0, 1) = WorksheetFunction.SumIfs(nas, naser, c)
  c.Offset(0, 2) = WorksheetFunction.SumIfs(d, naser, c)
  c.Offset(0, 3) = WorksheetFunction.SumIfs(f, naser, c)
  c.Offset(0, 4) = WorksheetFunction.SumIfs(j, naser, c)
  c.Offset(0, 5) = WorksheetFunction.SumIfs(l, naser, c)
  c.Offset(0, 6) = WorksheetFunction.SumIfs(ab, naser, c)
  c.Offset(0, 7) = WorksheetFunction.SumIfs(ac, naser, c)
  c.Offset(0, 8) = WorksheetFunction.SumIfs(af, naser, c)


 ' End If
          Next
End Sub 

[naser1357]

سلام
بازهم این خطا داد عکس پیوست هست

[iranweld]

آیا دیتای شما که باید فراخوانی شوند در شیت ۳ قرار دارد؟
نام فارسب شیت شما چیست؟

[naser1357]

مثل همون فایل پیوست هست

[iranweld]

مثل همون فایل پیوست هست

بدون مشکل جواب میده

[naser1357]

سلام ماکروی مشابه دیگری به شکل دیگری وجود ندارد؟

[naser1357]

ماکروی مشابه دیگری با فرمت دیگری وجود ندارد؟؟ دلیل خطا بنظرم اینست که در سلول ها بجای عدد

#div/0!

وجود دارد
ماکرویی برای حذف

#div/0!

وجود دارد؟

#div/0!

[naser1357]

ممنون می شوم اگر ماکرو را با vlookup بازنویسی کنین

[iranweld]

ممنون می شوم اگر ماکرو را با vlookup بازنویسی کنین

با سلام

ماکرو ذیل را تست کنید

Sub test()
z1 = Cells(Rows.Count, "A").End(xlUp).Row
z2 = Sheet3.Cells(Sheet3.Rows.Count, "A").End(xlUp).Row
Range("B4:L1400").ClearContents
For i = 4 To z1
For j = 2 To z2
If Sheet1.Range("A" & i) = Sheet3.Range("A" & j) Then
Sheet3.Range("b" & j & ":L" & j).Copy Destination:=Sheet1.Range("B" & i)
Exit For
End If
Next
Next
End Sub