Question

在Tim和Paul的帮助下，代码现在可以正常工作了。我认为它很有用，可以帮助其他人学习如何使用类模块，因此将代码更新为工作版本并将其保留在网站上。它从Excel工作表中获取一个表，将数据加载到类模块中的数组中，获取数组成员，更改成员并更新工作表表。比阵列更容易使用。

Option Explicit
Option Base 0


Dim myArray As Variant
Public dID, dPARAM
Public DATA As Variant

Sub GET_DATA(TBL As String)
Dim WS As String

    WS = Names(TBL).RefersToRange.Parent.NAME
    DATA = Worksheets(WS).Range(TBL).CurrentRegion.Value
End Sub

Property Get TESTARRAY() As Variant
TESTARRAY = myArray
End Property

Property Let TESTARRAY(DATA As Variant)
 myArray = DATA
End Property

Function INIT(TBL As String)
    Call GET_DATA(TBL)
    TESTARRAY = DATA
End Function


Function NO_IDS()
NO_IDS = dID.Count
End Function


Function IDS(TBL As String)
Dim ROW As Integer, COL As Integer
Dim Test As Boolean
Set dID = CreateObject("Scripting.Dictionary")
Set dPARAM = CreateObject("Scripting.Dictionary")
Dim VAL As Variant

Call GET_DATA(TBL)

'save array members
For ROW = LBound(DATA, 1) To UBound(DATA, 1)
    dID.ADD Item:=CStr(ROW), KEY:=CStr(DATA(ROW, 1))
Next ROW

For COL = LBound(DATA, 2) To UBound(DATA, 2)
    dPARAM.ADD Item:=CStr(COL), KEY:=CStr(DATA(1, COL))
Next COL

End Function


Function UPDATE_MTX(TBL As String)
Dim RESULT As Variant
Dim WS As String
Dim RNGE As Range, RNGE_ADD As String
Dim ROW As Integer, COL As Integer

On Error GoTo TRAP_ERR:

RESULT = myArray
WS = Names(TBL).RefersToRange.Parent.NAME
ROW = Worksheets(WS).Range(TBL).CurrentRegion.Rows.Count
COL = Worksheets(WS).Range(TBL).CurrentRegion.Columns.Count
Set RNGE = Worksheets(WS).Range(TBL).Resize(ROW, COL)
RNGE_ADD = RNGE.Address


RNGE.Value = RESULT

TRAP_ERR:
MsgBox "ERROR FOUND"

End Function


Function CHANGE_MTX(ID As String, PARAM As String, VAL As Variant)
Dim ROW As Integer
Dim COL As Integer

If dID.exists(ID) And dPARAM.exists(PARAM) Then
    ROW = CInt(dID(ID))
    COL = CInt(dPARAM(PARAM))
    myArray(ROW, COL) = VAL
Else
    CHANGE_MTX = "FAIL"
End If

End Function

Function GET_VAL(ID As String, PARAM As String)
Dim ROW As Integer
Dim COL As Integer


If dID.exists(ID) And dPARAM.exists(PARAM) Then
    ROW = CInt(dID(ID))
    COL = CInt(dPARAM(PARAM))
    GET_VAL = myArray(ROW, COL)
    Exit Function
Else
    GET_VAL = "FAIL"
End If

End Function



'test code in a module
 Sub testcls()

 Dim Test As New clsTABLE
 Dim VAL As Variant

 Test.IDS ("tbl_TEST")
 Test.INIT ("tbl_TEST")
 VAL = Test.GET_VAL("10", "E")
 Call Test.CHANGE_MTX("10", "E", "xxx")

 Call Test.UPDATE_MTX("tbl_TEST")

 End Sub

Excel VBA - 使用类模块和字典

0 个答案: