| Book1 | |||||||
|---|---|---|---|---|---|---|---|
| A | B | C | D | E | |||
| 1 | 1 | Apple | 1 | Apple | |||
| 2 | 3 | Banana | 2 | Pear | |||
| 3 | 2 | Pear | 3 | Banana | |||
| 4 | 1 | Apple | |||||
Lookup | |||||||
| Cell Formulas | ||
|---|---|---|
| Range | Formula | |
| B1 | =VLOOKUP(A1,$D$1:$E$3,2,0) | |
Yes, it will need to be done by vba.
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim MyNum As Long
If Target.Value <> "" And IsNumeric(Target.Value) = True Then
MyNum = 60 - WorksheetFunction.Ceiling(Target.Value, 60) + Target.Value
Target = GeEnumValues("StrEnumVal", MyNum)
End If
End Sub
Public Enum fruit_and_veg
Apple = 1
Apricot = 2
Asparagus = 3
Aubergine = 4
Avocado = 5
Banana = 6
Beetroot = 7
Black_eye_bean = 8
Broad_bean = 9
Broccoli = 10
Brussels_sprout = 11
Butternut_Squash = 12
Carrot = 13
Cherry = 14
Clementine = 15
Courgette = 16
Date = 17
Elderberry = 18
Fennel = 19
Fig = 20
Garlic = 21
Grape = 22
Green_bean = 23
Guava = 24
Haricot_bean = 25
Honeydew_melon = 26
Iceberg_lettuce = 27
Jerusalem_artichoke = 28
Kiwi_fruit = 29
Leek = 30
Lemon = 31
Mango = 32
Melon = 33
Mushroom = 34
Nectarine = 35
Nut = 36
Olive = 37
Orange = 38
Pea = 39
Peanut = 40
Pear = 41
Pepper = 42
Pineapple = 43
Pumpkin = 44
Quince = 45
Radish = 46
Raisin = 47
Rhubarb = 48
Satsuma = 49
Strawberry = 50
Sweet_potato = 51
Tomato = 52
Turnip = 53
Ugli_fruit = 54
Victoria_plum = 55
Vine_leaf = 56
Watercress = 57
Watermelon = 58
Yam = 59
Zucchini = 60
End Enum
Function GeEnumValues(PrcName As String, EnumItm As Long)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Reference:Microsoft Visual Basic for Extensibility 5.3 is required'
' Fahad Mubark AL-Dossary '
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim VBProj As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent
Dim CodeMod As VBIDE.CodeModule
Dim ProcStrLn As Long, ProcAcStrLn As Long, ProcCntLn As Long, N As Long, D As Long, S As Long, PrcCnountLine As Long
Dim DecStrLn As Long, DecEndLn As Long
Dim ThisLine As String, Dec As String, ThisSub As String, Itm As String
Dim DecItm As Variant
Set VBProj = ThisWorkbook.VBProject
For Each VBComp In VBProj.VBComponents
With VBComp
If .Type = vbext_ct_StdModule Then ' Withen Standr Module
With .CodeModule
If InStr(1, .Lines(1, .CountOfLines), PrcName) > 0 Then 'Replace Sub Function
On Error Resume Next
ProcStrLn = .ProcStartLine(PrcName, vbext_pk_Proc) ' Procedure Start Line
ProcAcStrLn = .ProcBodyLine(PrcName, vbext_pk_Proc) ' Actually Procedure Start Line
ProcCntLn = .ProcCountLines(PrcName, vbext_pk_Proc)
PrcCnountLine = ProcCntLn - (ProcAcStrLn - ProcStrLn)
If ProcAcStrLn > 0 Then
Else '____________________________________________________________________________________________________
' Replce Declaration such as Enum
For D = 1 To .CountOfDeclarationLines
ThisLine = .Lines(D, 1)
If InStr(1, ThisLine, "Enum " & PrcName) > 0 Then
Titl = DecItm(D)
Dec = Dec & vbNewLine & ThisLine: DecStrLn = D
S = InStr(1, ThisLine, "Enum " & PrcName) + Len("Enum " & PrcName) 'Start replace column
ElseIf InStr(1, Dec, "Enum " & PrcName) > 0 And InStr(1, ThisLine, "End Enum") > 0 Then
Dec = Dec & vbNewLine & ThisLine: DecEndLn = D
Exit For
ElseIf InStr(1, Dec, "Enum " & PrcName) Then
Dec = Dec & vbNewLine & ThisLine
End If
Next 'Declaration
' MsgBox .Lines(DecStrLn, DecEndLn - DecStrLn + 1) '=MsgBox Dec 'Declaration
End If '_______________________________________________________________________________________________________
On Error GoTo 0
End If
End With ' .CodeModule
End If ' .Type
End With ' VBComp
Next ' In VBProj.VBComponents
'Declaration
DecItm = Split(Dec, vbNewLine)
For D = LBound(DecItm) To UBound(DecItm)
Itm = DecItm(D)
If Itm <> "" And InStr(1, Itm, "Enum " & PrcName, vbTextCompare) = 0 And InStr(1, Itm, "End Enum") = 0 Then
If InStr(1, Itm, " = ", vbTextCompare) > 0 Then
N = Split(Itm, " = ")(1)
Else
Itm = Itm & " = " & N
End If
If EnumItm = N Then
GeEnumValues = Trim(Split(Itm, " = ")(0))
Exit Function
End If
N = N + 1
End If
Next
End Function[COLOR=#008000]Public Sub Add_Microsoft_Visual_Basic_for_Extensibility()[/COLOR]
[COLOR=#008000] AddRef ThisWorkbook, "{0002E157-0000-0000-C000-000000000046}", "VBIDE", 5, 3 'if need or delete this line. To select required Reference[/COLOR]
[COLOR=#008000]End Sub[/COLOR]
Sub AddRef(wbk As Workbook, sGuid As String, sRefName As String, sRefMajor As Long, sRefMinor As Long)
Dim i As Integer
On Error GoTo EH
With wbk.VBProject.References
For i = 1 To .Count
If .Item(i).Name = sRefName Then
Exit For
End If
Next i
If i > .Count Then
.AddFromGuid sGuid, sRefMajor, sRefMinor ' 0,0 should pick the latest version installed on the computer
End If
End With
EX: Exit Sub
EH: MsgBox "Error in 'AddRef'" & vbCrLf & vbCrLf & Err.Description
Resume EX
Resume ' debug code
ThisWorkbook.Save
End SubPrivate Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim MyNum As Long
If Target.Value <> "" And IsNumeric(Target.Value) = True Then
MyNum = 60 - WorksheetFunction.Ceiling(Target.Value, 60) + Target.Value
'[COLOR=#333333]Target = GeEnumValues([/COLOR][B][COLOR=#ff0000]"StrEnumVal"[/COLOR][/B][COLOR=#333333], MyNum)' [/COLOR][COLOR=#ff0000]X wrong[/COLOR]
[COLOR=#006400] Target = GeEnumValues([/COLOR][B][COLOR=#008000]"fruit_and_veg[/COLOR][/B][COLOR=#008000]"[/COLOR][COLOR=#006400], MyNum)' / Right[/COLOR]
End If
End Sub
