اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

lionheart

الخبراء
  • Posts

    671
  • تاريخ الانضمام

  • تاريخ اخر زياره

  • Days Won

    28

كل منشورات العضو lionheart

  1. Sub TestCode() Dim v, w, m As Long With Sheet1 m = .Columns(3).Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious, LookIn:=xlValues).Row v = .Range("B6:O" & m).Value w = Application.Index(v, Evaluate("ROW(1:" & UBound(v, 1) & ")"), [{1,2,3,14}]) Sheet2.Range("K3").Resize(UBound(v, 1), UBound(v, 2)).Value = w End With End Sub
  2. Sub ADDITEM() Dim x, itemRow As Long, availRow As Long With Sheet2 If .Range("K3").Value = Empty Then Exit Sub Application.EnableEvents = False itemRow = Range("K3").Value availRow = Range("F999").End(xlUp).Row + 1 Range("B4").Value = Sheet4.Range("B" & itemRow).Value Range("D5").Value = Sheet4.Range("D" & itemRow).Value Range("B5").Value = 1 Range("F" & availRow).Value = Range("B4").Value Range("G" & availRow).Value = Range("B5").Value Range("H" & availRow).Value = Range("D5").Value Range("I" & availRow).Value = "=H" & availRow & "*G" & availRow Application.EnableEvents = True End With End Sub Private Sub Worksheet_Change(ByVal Target As Range) Dim x, xx, RecptRow As Long If Not Intersect(Target, Range("B3")) Is Nothing And Range("B3").Value <> Empty Then xx = Application.Match(Range("B3"), Sheet4.Columns(1), 0) If Not IsError(xx) Then Range("B4").Value = Sheet4.Cells(xx, 2).Value x = Application.Match(Range("B4").Value, Columns(6), 0) If IsError(x) Then ADDITEM End If If Not Intersect(Target, Range("B5,D5")) Is Nothing And Range("K2").Value = False And Range("K1").Value <> Empty Then x = Application.Match(Range("B4").Value, Columns(6), 0) If IsError(x) Then RecptRow = IIf(Range("K5").Value = 0, Range("K1").Value, Range("K5").Value) Else RecptRow = x End If If Not Intersect(Target, Range("B5")) Is Nothing Then Range("G" & RecptRow).Value = Val(Range("G" & RecptRow).Value) + Target.Value If Not Intersect(Target, Range("D5")) Is Nothing Then Range("H" & RecptRow).Value = Val(Range("H" & RecptRow).Value) + Target.Value End If End Sub Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Not Intersect(Target, Range("f13:i999")) Is Nothing And Range("f" & Target.Row).Value <> Empty Then Range("K1").Value = Target.Row Range("K2").Value = True Range("b4").Value = Range("F" & Target.Row).Value Range("B5").Value = Range("G" & Target.Row).Value Range("D5").Value = Range("H" & Target.Row).Value Range("K2").Value = False End If End Sub
×
×
  • اضف...

Important Information