DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Run Time Error -2147417848 (80010108)
Method '_Default' of object 'Range' failed
Private Sub Worksheet_Change(ByVal Target As Range)
son = WorksheetFunction.Max(Cells(Rows.Count, "B").End(3).Row + 1, 3)
If Intersect(Target, Range("B3:B" & son)) Is Nothing Then Exit Sub
Set s2 = Sheets("RAF GİR")
raf = s2.Cells(Rows.Count, "E").End(3).Row
[COLOR="Red"]adet = WorksheetFunction.CountIf(s2.Range("E3:E" & raf), Left(Target * 1, 7))[/COLOR]
If adet = 1 Then
For i = 3 To raf
If Left(Target * 1, 7) = s2.Cells(i, "E") Then
Target.Offset(0, 1) = s2.Cells(i, "D")
Target.Offset(0, 2) = s2.Cells(i, "F")
Target.Offset(0, 3) = Left(Target * 1, 7)
Target.Offset(0, 5) = s2.Cells(i, "G")
End If
i = raf
Next
Else
If adet > 1 Then
yeni = Target.Row
For i = 3 To raf
If Left(Target * 1, 7) = s2.Cells(i, "E") Then
Cells(yeni, "B") = Target
Cells(yeni, "C") = s2.Cells(i, "D")
Cells(yeni, "D") = s2.Cells(i, "F")
Cells(yeni, "E") = Left(Target * 1, 7)
Cells(yeni, "G") = s2.Cells(i, "G")
yeni = yeni + 1
End If
Next
Else
MsgBox ("Girdiğiniz barkod, RAF GİR sayfasında bulunmamaktadır!")
End If
End If
End Sub
Set s2 = Sheets("RAF GİR")
[COLOR="Red"]Application.EnableEvents = False[/COLOR]
Application.EnableEvents = True
Kod sayfada değişiklik yaptığı için defalarca change olayını çalıştırıyor. Bu da hafıza tüketiyor.
Kodunuzun başına ve sonuna aşağıdaki satırları ilave edip deneyiniz.
Başına:
Sonuna:Kod:Set s2 = Sheets("RAF GİR") [COLOR="Red"]Application.EnableEvents = False[/COLOR]
İyi çalışmalar...Kod:Application.EnableEvents = True
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("B3:B2000")) Is Nothing Then Exit Sub
Application.EnableEvents = False
Set s2 = Sheets("RAF GİR")
If WorksheetFunction.CountIf(s2.Range("E3:E2000"), Left(Target * 1, 7) * 1) = 1 Then
For i = 3 To s2.Cells(Rows.Count, "E").End(3).Row
If Left(Target * 1, 7) * 1 = s2.Cells(i, "E") Then
Target.Offset(0, 1) = s2.Cells(i, "D")
Target.Offset(0, 2) = s2.Cells(i, "F")
Target.Offset(0, 3) = Left(Target * 1, 7) * 1
Target.Offset(0, 5) = s2.Cells(i, "G")
If Mid((Target * 1), 9, Len(Target) - 9) = "01" Or Mid((Target * 1), 9, Len(Target) - 9) = "02" Or Mid((Target * 1), 9, Len(Target) - 9) = "03" _
Or Mid((Target * 1), 9, Len(Target) - 9) = "04" Or Mid((Target * 1), 9, Len(Target) - 9) = "05" Or Mid((Target * 1), 9, Len(Target) - 9) = "01" Then
Target.Offset(0, 4) = WorksheetFunction.Index(["XS", "S", "M", "L", "XL", "XXL"], Mid((Target * 1), 9, Len(Target) - 9) * 1)
Else
Target.Offset(0, 4) = Mid((Target * 1), 9, Len(Target) - 9)
End If
End If
i = s2.Cells(Rows.Count, "E").End(3).Row
Next
Else
If WorksheetFunction.CountIf(s2.Range("E3:E2000"), Left(Target * 1, 7) * 1) > 1 Then
yeni = Target.Row
For i = 3 To s2.Cells(Rows.Count, "E").End(3).Row
If Left(Target * 1, 7) * 1 = s2.Cells(i, "E") Then
Cells(yeni, "B") = Target
Cells(yeni, "C") = s2.Cells(i, "D")
Cells(yeni, "D") = s2.Cells(i, "F")
Cells(yeni, "E") = Left(Target * 1, 7) * 1
Cells(yeni, "G") = s2.Cells(i, "G")
If Mid(Cells(yeni, "B") * 1, 9, Len(Cells(yeni, "B") - 9)) = "01" Or Mid(Cells(yeni, "B") * 1, 9, Len(Cells(yeni, "B") - 9)) = "02" Or Mid(Cells(yeni, "B") * 1, 9, Len(Cells(yeni, "B") - 9)) = "03" _
Or Mid(Cells(yeni, "B") * 1, 9, Len(Cells(yeni, "B") - 9)) = "04" Or Mid(Cells(yeni, "B") * 1, 9, Len(Cells(yeni, "B") - 9)) = "05" Or Mid(Cells(yeni, "B") * 1, 9, Len(Cells(yeni, "B") - 9)) = "01" Then
Cells(Cells(yeni, "B"), "F") = WorksheetFunction.Index(["XS", "S", "M", "L", "XL", "XXL"], Mid(Cells(yeni, "B") * 1, 9, Len(Cells(yeni, "B") - 9)) * 1)
Else
Cells(yeni, "F") = Mid(Cells(yeni, "B") * 1, 9, Len(Cells(yeni, "B") - 9))
End If
yeni = yeni + 1
End If
Next
Else
MsgBox ("Girdiğiniz barkod, RAF GİR sayfasında bulunmamaktadır!")
End If
End If
Application.EnableEvents = True
End Sub