반응형
Excel VBA - 열거된 요소의 값 설정
클래스 모듈에는 다음이 있습니다.
Private Enum colType
ID = "A"
SSN = "B"
lName = "H"
fName = "G"
End Enum
개인 회원으로서클래스가 초기화될 때마다 컴파일 오류가 발생합니다. 메시지 불일치를 입력합니다.만약 내가 선언한다면colType~하듯이Private Enum coltype As String오류로 빨간색으로 강조 표시되고 다음과 같은 메시지가 표시됩니다.
컴파일 오류: 문 끝이 필요합니다.
열거된 요소의 값을 지정하는 것이 Excel VBA에서 허용되지 않습니까?
댓글에 적혀있는 것처럼, 이것은 불가능합니다.제가 과거에 사용했던 해결 방법이 있습니다.보유:
Private Enum colType
ID = 1
SSN = 2
lName = 3
fName = 4
End Enum
그런 다음 다음과 같은 함수의 별도 String 속성을 만듭니다.
Public Property Get colType_String(colType) as String
Dim v as Variant
v= Array("A","B", ...)
colType_String = vba.cstr(v(colType))
End Property
이것이 가장 보편적인 해결책은 아니지만, 구현하기도 쉽고 효과도 있습니다.클래스 모듈에 이미 이 속성이 있는 경우 개인 colType 변수에 대한 속성을 사용할 수도 있으며 속성에 colType을 입력할 필요가 없습니다.
저는 특정 상황에서 전 남자의 해결책을 꽤 좋아합니다. 그래서 저는 그것을 지지했습니다.흔히 상정되는 솔루션은 다음과 같습니다.
Enum myEnum
myName1 = 1
myName2 = 2
myName3 = 3
End Enum
Function getEnumName(eValue As myEnum)
Select Case eValue
Case 1
getEnumName = "myName1"
Case 2
getEnumName = "myName2"
Case 3
getEnumName = "myName3"
End Select
End Function
Debug.Print getEnumName(2) prints "myName2"
저는 이 질문에 대한 답을 매우 오랫동안 찾고 있었습니다.사례 문 또는 배열에 Enum의 내용을 다시 나열하지 않습니다.답을 찾지 못했지만, 모듈 내용을 변경할 코드를 찾은 후에 할 수 있었습니다.이를 수정하여 모듈 1에 배치할 다음과 같은 작업 코드가 생성되었습니다.
Option Explicit
Enum MensNames
Fred
Trev = 5
Steve
Bill = 27
Colin
Andy
End Enum
Sub EnumStringTest()
MsgBox EnumString(Steve) & " = " & Steve
End Sub
Function EnumString(EnumElement As MensNames) As String
Dim iLineNo As Integer
Dim iElementNo As Integer
iElementNo = 0
EnumString = vbNullString
With ThisWorkbook.VBProject.VBComponents("Module1").CodeModule
' Find the Enum Start
For iLineNo = 1 To .CountOfLines
If InStr(.Lines(iLineNo, 1), "Enum MensNames") > 0 Then
Exit For
End If
Next iLineNo
' Find the required Element
iLineNo = iLineNo + 1
Do While InStr(.Lines(iLineNo, 1), "End Enum") = 0 And .Lines(iLineNo, 1) <> ""
If InStr(2, .Lines(iLineNo, 1), "=") > 0 Then
iElementNo = CLng(Mid(.Lines(iLineNo, 1), InStr(2, .Lines(iLineNo, 1), "=") + 1))
End If
If iElementNo = EnumElement Then
EnumString = Left(Trim(.Lines(iLineNo, 1)), IIf(InStr(1, Trim(.Lines(iLineNo, 1)), " ") = 0, 1000, InStr(1, Trim(.Lines(iLineNo, 1)), " ") - 1))
Exit Do
End If
iElementNo = iElementNo + 1
iLineNo = iLineNo + 1
Loop
End With
End Function
Rich Harding의 솔루션을 개선하기 위해, 저는 가독성을 개선하고 실수하기 쉽게 하기 위해 열거형을 사용합니다.
Enum myEnum
myName
someOtherName
lastName
End Enum
Function getEnumName(eValue As myEnum) As String
Select Case eValue
Case myName: getEnumName = "myName"
Case someOtherName: getEnumName = "someOtherName"
Case lastName: getEnumName = "lastName"
End Select
End Function
Enum의 긴 정수는 Base-10 인코딩일 수 있습니다.아래 ToAlpha 함수는 대문자 알파벳 문자로 표시되는 숫자를 Base-26으로 변환합니다.번호를 얻으려면 문자열을 사용하여 ToLong 함수를 호출합니다.
이 값은 최대 6자까지 작동합니다(2,147,483,647보다 큰 값은 Enum 값을 초과합니다).
Private Enum colType
ID = 0 'A
SSN = 1 'B
lName = 7 'H
fName = 6 'G
WORD = 414859
FXSHRXX = 2147483647 'Maximum long
End Enum
Sub test()
Debug.Print "ID: " & ToAlpha(colType.ID)
Debug.Print "SSN: " & ToAlpha(colType.SSN)
Debug.Print "lName: " & ToAlpha(colType.lName)
Debug.Print "fName: " & ToAlpha(colType.fName)
Debug.Print "WORD: " & ToAlpha(colType.WORD)
Debug.Print "FXHRXX: " & ToAlpha(colType.FXSHRXX)
End Sub
Function ToAlpha(ByVal n)
If n < 0 Or Int(n) <> n Then Exit Function 'whole numbers only
Do While n > 25
ToAlpha = Chr(n Mod 26 + 65) & ToAlpha
n = n \ 26 - 1 'base 26
Loop
ToAlpha = Chr(n + 65) & ToAlpha
End Function
Function ToLong(ByVal s)
s = UCase(s)
Dim iC
For i = 1 To Len(s)
iC = Asc(Mid(s, i, 1))
If iC < 65 Or iC > 90 Then 'A-Z only
ToLong = -1
Exit Function
End If
ToLong = ToLong * 26 + (iC - 64) 'base 26
Next
ToLong = ToLong - 1
End Function
이에 대한 저의 해결책은 다음과 같습니다.
Private Enum ColType
ID = 1
SSN = 2
lName = 3
fName = 4
End Enum
Private Function GetEnumName(ByVal value As ColType)
GetEnumName = Choose(value, _
"A", _
"B", _
"H", _
"G" _
)
End Function
사용.Choose더 깔끔해 보입니다.
샘플 사용량:... = GetEnumName(ColType.ID)
이것이 도움이 되길 바랍니다.
참조: (Microsoft Visual Basic for Application Extensibility 5.3)이 필요합니다.
Public Enum SecurityLevel
IllegalEntry = 0
SecurityLevel1 = 1
SecurityLevel2 = 3
SecurityLevel3
SecurityLevel4 = 10
End Enum
Public Sub Test1()
Cells.Clear
Range("A1").Value = StrEnumVal("SecurityLevel", SecurityLevel.IllegalEntry)
Range("A2").Value = StrEnumVal("SecurityLevel", SecurityLevel.SecurityLevel1)
Range("A3").Value = StrEnumVal("SecurityLevel", SecurityLevel.SecurityLevel2)
Range("A4").Value = StrEnumVal("SecurityLevel", SecurityLevel.SecurityLevel3)
Range("A5").Value = StrEnumVal("SecurityLevel", SecurityLevel.SecurityLevel4)
End Sub
Public Sub AaaTest2()
Cells.Clear
Dim E As Long
For E = SecurityLevel.IllegalEntry To SecurityLevel.SecurityLevel4
Cells(E + 1, 1) = StrEnumVal("SecurityLevel", E)
Next
End Sub
Function StrEnumVal(BEnumName As String, EnumItm As Long) As String
'''''''''''''''''''''''''
' Fahad Mubark ALDOSSARY'
'''''''''''''''''''''''''
Dim vbcomp As VBComponent
Dim modules As Collection
Dim CodeMod As VBIDE.CodeModule
Dim numLines As Long ' end line
Dim MdlNm As String
Dim lineNum As Long
Dim thisLine As String, SpltEnm As String, EnumITems As String, Itm As String
Dim EEnumName As String
Dim Indx As Long
Dim I As Long, s As Long
Dim SpltEI As Variant
Indx = 0
Set modules = New Collection
BEnumName = "Enum " & BEnumName
EEnumName = "End Enum"
For Each vbcomp In ThisWorkbook.VBProject.VBComponents
'if normal or class module
If vbcomp.Type = vbext_ct_StdModule Then
Set CodeMod = vbcomp.CodeModule
With CodeMod
numLines = .CountOfLines
For lineNum = 1 To numLines
thisLine = .Lines(lineNum, 1)
If InStr(1, thisLine, BEnumName, vbTextCompare) > 0 Then
If InStr(thisLine, ":") > 0 Then
' thisLine = Replace(thisLine, BEnumName & ":", "") ' Remove Enum Titel Enum
thisLine = Right(thisLine, Len(thisLine) - InStr(1, thisLine, ":"))
For s = 0 To UBound(Split(thisLine, ":"))
SpltEnm = Split(thisLine, ":")(s)
If InStr(SpltEnm, " = ") > 0 Then
Itm = SpltEnm
Indx = CDbl(Split(SpltEnm, " = ")(1))
Else
Itm = SpltEnm & " = " & Indx
End If
EnumITems = EnumITems & IIf(EnumITems <> "", vbNewLine, "") & Itm '''''
Indx = Indx + 1
Next
If InStr(1, thisLine, EEnumName, vbTextCompare) > 0 Then
EnumITems = Replace(EnumITems, "End Enum", "")
Exit For
End If
Else
'Only Title show if nothing bedside
End If
ElseIf InStr(1, thisLine, EEnumName, vbTextCompare) > 0 Then
If InStr(thisLine, ":") > 0 Then
For s = 0 To UBound(Split(thisLine, ":"))
SpltEnm = Split(thisLine, ":")(s)
If InStr(SpltEnm, " = ") > 0 Then
Itm = SpltEnm
Indx = CDbl(Split(SpltEnm, " = ")(1))
Else
Itm = SpltEnm & " = " & Indx
End If
EnumITems = EnumITems & IIf(EnumITems <> "", vbNewLine, "") & Itm '''''
EnumITems = Replace(EnumITems, "End Enum", "")
Indx = Indx + 1
Next
Else
End If
Exit For
Else
If InStr(thisLine, ":") > 0 Then
For s = 0 To UBound(Split(thisLine, ":"))
SpltEnm = Split(thisLine, ":")(s)
If InStr(SpltEnm, " = ") > 0 Then
Itm = SpltEnm
Indx = CDbl(Split(SpltEnm, " = ")(1))
Else
Itm = SpltEnm & " = " & Indx
End If
EnumITems = EnumITems & IIf(EnumITems <> "", vbNewLine, "") & Itm '''''
Indx = Indx + 1
Next
Else
If InStr(thisLine, " = ") > 0 Then
Itm = thisLine
Indx = Split(thisLine, " = ")(1)
Else
Itm = thisLine & " = " & Indx
End If
EnumITems = EnumITems & IIf(EnumITems <> "", vbNewLine, "") & Itm '''''
End If
Indx = Indx + 1
End If
Next lineNum
If InStr(1, thisLine, EEnumName, vbTextCompare) > 0 Then Exit For
End With 'CodeMod
End If
Next vbcomp
SpltEI = Split(EnumITems, vbNewLine)
For I = LBound(SpltEI) To UBound(SpltEI)
If CDbl(Replace(Split(SpltEI(I), " = ")(1), " ", "")) = EnumItm Then
StrEnumVal = Replace(Split(SpltEI(I), " = ")(0), " ", "")
Exit For
Else
End If
Next
End Function
활성화하려면 아래 코드를 복사한 후 삭제합니다.
Sub AddReferenceVBA()
AddRef ThisWorkbook, "{0002E157-0000-0000-C000-000000000046}", "VBIDE", 5, 3
End Sub
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
ThisWorkbook.Save
End If
End With
EX: Exit Sub
EH: MsgBox "Error in 'AddRef'" & vbCrLf & vbCrLf & Err.Description
Resume EX
Resume ' debug code
End Sub
업데이트 및 수정
Public Enum SecurityLevelp
IllegalEntry = 1
SecurityLVL1
SecurityLVL2 = 8
SecurityLVL3
SecurityLVL4 = 10
SecurityLVL5
SecurityLVL6 = 15
End Enum
Public Sub Test()
AddRef ThisWorkbook, "{0002E157-0000-0000-C000-000000000046}", "VBIDE", 5, 3 'if need or delete this line. To select required Reference
MsgBox GeEnumValues("SecurityLevelp", 1) 'to replace enum
MsgBox GeEnumValues("SecurityLevelp", SecurityLVL3) 'to replace enum
MsgBox GeEnumValues("SecurityLevelp", 11) 'to replace enum
MsgBox GeEnumValues("SecurityLevelp", SecurityLVL6) 'to replace enum
End Sub
Function GeEnumValues(PrcName As String, EnumItm As Long)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Reference:Microsoft Visual Basic for Extensibility 5.3 is required'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
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
'If PrcName = .ProcOfLine(ProcAcStrLn, vbext_pk_Proc) Then 'Get Proce Name
' For N = (ProcAcStrLn + 1) To (ProcAcStrLn + PrcCnountLine - 1) ' Add 1 to avoid chane Procedure Name and -1 to avoid replace Next Procedure
' ThisLine = .Lines(N, 1)
' If InStr(N, ThisLine, Fnd, vbTextCompare) > 0 Then
'ThisSub = ThisSub & vbNewLine & ThisLine
'End If
'Next
' End If
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
' if needed o delte below code
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 Sub
Enum 대신 Type(구조체)을 정의합니다.
Public Type colType
ID As String
SSN As String
lName As String
fName As String
End Type
그런 다음 colType 유형의 개체를 만들고 원하는 값을 설정합니다.
Public myColType As colType
myColType.ID = "A"
myColType.SSN = "B"
myColType.lname = "H"
myColType.fName = "G"
언급URL : https://stackoverflow.com/questions/20846854/excel-vba-set-values-of-enumerated-elements
반응형
'programing' 카테고리의 다른 글
| jQuery를 사용하여 테이블 헤더를 뷰 밖으로 스크롤할 때 맨 위에 고정된 상태로 유지합니다. (0) | 2023.08.22 |
|---|---|
| numpy 배열을 Excel 파일로 덤프 (0) | 2023.08.22 |
| Swift에서 사용자 상호 작용을 비활성화하는 방법UI 보기? (0) | 2023.08.22 |
| 무한 재귀 오류 없이 __getattribute__를 구현하려면 어떻게 해야 합니까? (0) | 2023.08.17 |
| Excel VBA에 개체 필요 오류가 있습니다. (0) | 2023.08.17 |