Ilgili iki tablo arasında birinden diğerine
bilgi aktarmak istiyoruz . Tablo ektedir.
bilgi aktarmak istiyoruz . Tablo ektedir.
Ekli dosyalar
-
137.9 KB Görüntüleme: 22
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
Hay Allah razı olsun. Gece saatler harcadım çözmek için, deli olacaktım nerdeyse.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