通过集合的成员循环,我如何获得成员的密钥?

时间:2016-09-01 21:22:07

标签: excel vba excel-vba

所以我必须将一堆微调器对象移动到一组单元格旁边。

对于每个微调器,我需要运行这些语句

Worksheets("Serial").spnAspect.Left = Worksheets("Serial").Range("I12").Left - Worksheets("Serial").spnAspect.Width
Worksheets("Serial").spnAspect.Top = Worksheets("Serial").Range("I12").Top + Worksheets("Serial").Range("I12").Height / 2 _
                                        - Worksheets("Serial").spnAspect.Height / 2

所以我想让它更整洁一点,所以我做了以下子。 我在这里唯一的问题是如何告诉它哪个单元格与每个微调器对齐。这是“I12”,在每次迭代中都应该是thisControl在集合中的关键。

Sub MoveSpinners()

    Dim myControls As New Collection
    Dim thisControl As Object
    Dim mySheet As Worksheet

    myControls.Add Worksheets("Serial").spnHeight, "I11"
    myControls.Add Worksheets("Serial").spnAspect, "I12"
    myControls.Add Worksheets("Serial").spnCropleft, "I13"
    myControls.Add Worksheets("Serial").spnCropRight, "I14"
    myControls.Add Worksheets("Serial").spnCropTop, "I15"
    myControls.Add Worksheets("Serial").spnCropBottom, "I16"

    Set mySheet = Worksheets("Serial")

    For Each thisControl In myControls

        thisControl.Left = mySheet.Range("I12").Left - thisControl.Width
        thisControl.Top = mySheet.Range("I12").Top + thisControl.Height / 2 _
                                        - thisControl.Height / 2
    Next

End Sub

这是与Get the key of an item on a Collection object相同的问题,在这种情况下通过“使用字典对象”来回答,但在我的情况下,它不起作用,因为它不像复制粘贴那样整洁排了很多次

我正在考虑的另一种选择是 fMoveSpinner(thisSpinner作为对象,myDestination作为范围)但我希望保持这个小的MoveSpinner子程序自包含。

如果你有更好的主意,我会很高兴听到它!

3 个答案:

答案 0 :(得分:2)

这是一个关于如何迭代集合的键的示例,但是,我认为使用字典实际上会更清洁,因为你想要做什么。

无论如何,这是一个例子:

Sub Iterate_Keys_Collection()
    Dim myControls As New Collection
    Dim thisControl As Variant

    myControls.Add Array("first key", "I11"), "I11"
    myControls.Add Array("second key", "I12"), "I12"
    myControls.Add Array("third key", "I13"), "I13"

    For Each thisControl In myControls
        If thisControl(0) = "first key" Then
            MsgBox (thisControl(0)) ' Print the 'first key'
                                    ' The Value is in thisControl(1)
        End If
    Next
End Sub

答案 1 :(得分:2)

我重构了您的代码以使用脚本字典。它对我来说看起来很整洁!

Scripting Dictionary的键和项都可以是对象。在这里,我将控件存储为键,将范围存储为项目。这样,当您访问密钥控件时,您可以轻松获取项目范围作为参考。

之前和之后

enter image description here

代码

Sub MoveSpinners2()

    Dim myControls As Object
    Dim thisControl As Object
    Dim mySheet As Worksheet
    Dim x As Long

    Set myControls = CreateObject("Scripting.Dictionary")

    With Worksheets("Serial")

        myControls.Add .spnHeight, .Range("I11")
        myControls.Add .spnAspect, .Range("I12")
        myControls.Add .spnCropleft, .Range("I13")
        myControls.Add .spnCropRight, .Range("I14")
        myControls.Add .spnCropTop, .Range("I15")
        myControls.Add .spnCropBottom, .Range("I16")

    End With

    For Each thisControl In myControls

        thisControl.Left = myControls(thisControl).Left - thisControl.Width
        thisControl.Top = myControls(thisControl).Top + thisControl.Height / 2 _
                          - thisControl.Height / 2
    Next

End Sub

答案 2 :(得分:1)

我使用Array方法添加0.02美分,因此不依赖于DictionaryCollection个对象:

Option Explicit

Sub MoveSpinners3()
    Dim iSpn As Long
    Dim spnArr As Variant
    Dim shp As Shape

    spnArr = Array("I11", "spnHeight", "I12", "spnAspect", "I13", "spnCropleft", "I14", "spnCropRight", "I15", "spnCropTop", "I16", "spnCropBottom")

    With Worksheets("Serial")
        For iSpn = LBound(spnArr) To UBound(spnArr) Step 2
            Set shp = .Shapes(spnArr(iSpn + 1))
            shp.Left = .Range(spnArr(iSpn)).Left - shp.Width
            shp.Top = .Range(spnArr(iSpn)).Top + shp.Height / 2 - shp.Height / 2
        Next
    End With
End Sub

维护范围和自旋按钮名称之间的(非常)可能有用的视觉配对,可以利用VBA连续字符重写上述代码:

Option Explicit

Sub MoveSpinners3()
    Dim iSpn As Long
    Dim spnArr As Variant
    Dim shp As Shape

    spnArr = Array("I11", "spnHeight", _
                   "I12", "spnAspect", _
                   "I13", "spnCropleft", _
                   "I14", "spnCropRight", _
                   "I15", "spnCropTop", _
                   "I16", "spnCropBottom")

    With Worksheets("Serial")
        For iSpn = LBound(spnArr) To UBound(spnArr) Step 2
            Set shp = .Shapes(spnArr(iSpn + 1))
            shp.Left = .Range(spnArr(iSpn)).Left - shp.Width
            shp.Top = .Range(spnArr(iSpn)).Top + shp.Height / 2 - shp.Height / 2
        Next
    End With
End Sub

虽然(最终?)重构以从选择中分离纯对齐规则代码,但可能如下:

Option Explicit

Sub MoveSpinners3()
    Dim iSpn As Long
    Dim spnArr As Variant
    Dim shp As Shape

    spnArr = Array("I11", "spnHeight", _
                   "I12", "spnAspect", _
                   "I13", "spnCropleft", _
                   "I14", "spnCropRight", _
                   "I15", "spnCropTop", _
                   "I16", "spnCropBottom")

    With Worksheets("Serial")
        For iSpn = LBound(spnArr) To UBound(spnArr) Step 2
            MoveSpin .Shapes(spnArr(iSpn + 1)), .Range(spnArr(iSpn))
        Next
    End With
End Sub

Sub MoveSpin(shp As Shape, rng As Range)
        shp.Left = rng.Left - shp.Width
        shp.Top = rng.Top + shp.Height / 2 - shp.Height / 2
End Sub

可以立即有利于增强OP的代码对齐规则,并避免由于行高不足而可能的自旋按钮重叠,如下所示:

Sub MoveSpin(shp As Shape, rng As Range)
        rng.RowHeight = shp.Height '<--| make rows height match spinbutton one
        shp.Left = rng.Left - shp.Width
        shp.Top = rng.Top + shp.Height / 2 - shp.Height / 2
End Sub