Advertisement
Guest User

Untitled

a guest
Apr 25th, 2019
78
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 2.55 KB | None | 0 0
  1. 'Option Explicit
  2.  
  3. Private Sub Lookup(ByVal Target As Range, ByVal ColNum As Integer, ByVal WS_DataBase As String)
  4. Dim Found As Integer
  5. Found = 0
  6.  
  7. If ColNum = 1 Then
  8. For i = 0 To Application.WorksheetFunction.CountA(Worksheets(WS_DataBase).Range("A:A")) - 2
  9. If Worksheets(WS_DataBase).Range("A2").Offset(i, 0).Value = Target.Value Then
  10. Target.Offset(0, 1).Value = Worksheets(WS_DataBase).Range("A2").Offset(i, 1).Value
  11. Target.Offset(0, 2).Value = Worksheets(WS_DataBase).Range("A2").Offset(i, 2).Value
  12. Target.Offset(0, 3).Value = Worksheets(WS_DataBase).Range("A2").Offset(i, 3).Value
  13. Target.Offset(0, 4).Value = Worksheets(WS_DataBase).Range("A2").Offset(i, 4).Value
  14. Found = Found + 1
  15. End If
  16. Next i
  17. End If
  18.  
  19. If ColNum = 3 Then
  20. For i = 0 To Application.WorksheetFunction.CountA(Worksheets(WS_DataBase).Range("A:A"))
  21. If Worksheets(WS_DataBase).Range("C2").Offset(i, 0).Value = Target.Value Then
  22. Target.Offset(0, -2).Value = Worksheets(WS_DataBase).Range("C2").Offset(i, -2).Value
  23. Target.Offset(0, -1).Value = Worksheets(WS_DataBase).Range("C2").Offset(i, -1).Value
  24. Target.Offset(0, 1).Value = Worksheets(WS_DataBase).Range("C2").Offset(i, 1).Value
  25. Target.Offset(0, 2).Value = Worksheets(WS_DataBase).Range("C2").Offset(i, 2).Value
  26. Found = Found + 1
  27. End If
  28. Next i
  29. End If
  30.  
  31. If Found = 0 Then
  32. MsgBox ("Nie znaleziono")
  33. Application.Undo
  34. ElseIf Found > 1 Then
  35. MsgBox (Found & " zduplikowane pozycje")
  36. End If
  37. End Sub
  38.  
  39. Private Sub Worksheet_Change(ByVal Target As Range)
  40. Application.EnableEvents = False
  41.  
  42. Dim WS_DataBase As String
  43. WS_DataBase = "B"
  44. 'SIZE
  45. If Selection.Count > 1 Then
  46. Application.Undo
  47. Application.EnableEvents = True
  48. MsgBox ("Zaznaczono więcej niż jedną komórkę")
  49. Exit Sub
  50. End If
  51.  
  52. 'CLEAR
  53. If Target.Value = "" And Target.Row > 1 Then
  54. Target.Rows.EntireRow.ClearContents
  55. Application.EnableEvents = True
  56. Exit Sub
  57. End If
  58.  
  59. 'LOOKUP
  60. If Target.Row > 1 Then
  61. If (Target.Column = 1 Or Target.Column = 3) And Target.Value <> "" Then
  62. Call Lookup(Target, Target.Column, WS_DataBase)
  63. Else
  64. Application.Undo
  65. End If
  66. End If
  67.  
  68. Application.EnableEvents = True
  69. End Sub
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement