如果选择了很多单元格,userform (spinner)返回类型不匹配的代码.VBA Excel



我知道类型不匹配通常是当您错误地定义变量时,但我不确定在这种情况下是否有意义。我的代码,张贴在下面,是一个用户表单上有一个旋转器,你在点击用户表单之前突出显示的单元格,当你点击旋转器按钮时,增加/减少指定的%。

对于较低数量的细胞,这是完美的。所以我可以选择5个不同的范围,每个4个单元格,例如,它将按照预期的方式运行,但是当我选择超过这个时,当我使用旋转器和调试器突出显示单个单元格时,我会得到类型不匹配错误。值=单个单元。值* pvar代码在下面。这似乎只影响所选范围的最后几行。

有谁知道这是为什么或者如何纠正这种情况吗?以我有限的知识,它似乎不完全有意义的类型不匹配错误。我唯一的假设是,在定义AS范围时,可以存储为范围的数量是有限制的?请参阅下面的代码:

打开罪人userform的代码

Public SelRange As Range
Public pvar As Double
Public SelVar As Double
Public InitVar As Double
Public GetAllValuesAtOnceAsArray As Variant
Sub Button2_Click()
Spinner.Show
End Sub

Userform代码

Option Explicit
'on opening userform this sets the variables
Private Sub UserForm_Activate()
pvar = 1
Set SelRange = Selection
GetAllValuesAtOnceAsArray = SelRange.Value
End Sub
'button to maintain adjusted values
Private Sub CommandButton1_Click()
UserForm3.Show
End Sub
'Button to return to starting values
Private Sub DefaultButton_Click()
Dim singlecell As Range
'write back the original values
SelRange.Value = GetAllValuesAtOnceAsArray
'Adjust every single Cell within range
pvar = 1
End Sub
'Spin Up button
Private Sub SpinButton1_SpinUp()
Application.ScreenUpdating = False
pvar = pvar + UpBox.Value / 100
'write back the original values
SelRange.Value = GetAllValuesAtOnceAsArray
Dim singlecell As Range
'Adjust every single Cell within range
For Each singlecell In SelRange.Cells
    singlecell.Value = singlecell.Value * pvar
Next singlecell

Application.ScreenUpdating = True
End Sub
' Spin Down button
Private Sub SpinButton1_SpinDown()
pvar = pvar - DownBox.Value / 100
'write back the original values
SelRange.Value = GetAllValuesAtOnceAsArray
Dim singlecell As Range
'Adjust every single Cell within range
For Each singlecell In SelRange.Cells
        singlecell.Value = singlecell.Value * pvar
Next singlecell
End Sub
' Reset values when closing userform unless specified otherwise
Private Sub UserForm_terminate()
'Now write back the original values
SelRange.Value = GetAllValuesAtOnceAsArray
End Sub

您提到您"选择了5个不同的范围,每个范围4个单元格",这似乎表明您正在选择不连续的范围。如果是这种情况,那么真正的问题可能是你试图在一个变量数组中存储和恢复范围内的值的方式。事情不是这样的。考虑下面的子元素:

Sub test1()
    Dim myRange As Range, myCopy As Variant
    Set myRange = Selection
    myCopy = myRange.Value
    myRange.ClearContents
    'now restore:
    myRange.Value = myCopy 'doesn't always work!
End Sub

用不同的值填充A1:B2和D1:E4范围,然后同时选择它们,先选择A1:B2,再选择D1:E4。您应该在D3:E4范围内看到#N/A——这就是导致实际类型不匹配的原因。

问题是不连续的范围是区域的集合,只有第一个区域被Value属性抓取。如果你真的想要存储和恢复值,你可以这样做:

Sub test2()
    Dim myRange As Range, myArea As Range
    Dim myCopy As Variant
    Dim i As Long, numAreas As Long
    Set myRange = Selection
    numAreas = myRange.Areas.Count
    If numAreas = 1 Then
        myCopy = myRange.Value
    Else
        ReDim myCopy(1 To numAreas)
        For i = 1 To numAreas
            myCopy(i) = myRange.Areas(i).Value
        Next i
    End If
    myRange.ClearContents
    'now restore:
    If numAreas = 1 Then
        myRange.Value = myCopy
    Else
        For i = 1 To numAreas
            myRange.Areas(i).Value = myCopy(i)
        Next i
    End If
End Sub

在您的情况下,您可能希望有myCopy和numAreas模块级变量。用于复制值的代码和用于恢复值的代码都可以移动到子代码中,以及用于将范围中的每个单元格乘以一个值的代码(对于spinup和spindown都很有用)。下面的3个子代码说明了这一点,然后是一个测试子代码,以显示子调用是如何工作的:

Sub CopyVals(R As Range, V As Variant)
    Dim A As Range
    Dim i As Long, n As Long
    n = R.Areas.Count
    If n = 1 Then
        V = R.Value
    Else
        ReDim V(1 To n)
        For i = 1 To n
            V(i) = R.Areas(i).Value
        Next i
    End If
End Sub
Sub RestoreVals(R As Range, V As Variant)
    Dim A As Range
    Dim i As Long, n As Long
    n = R.Areas.Count
    If n = 1 Then
        R.Value = V
    Else
        For i = 1 To n
            R.Areas(i).Value = V(i)
        Next i
    End If
End Sub
Sub Multiply(R As Range, p As Double)
    Dim c As Range
    For Each c In R.Cells
        c.Value = p * c.Value
    Next c
End Sub
Sub test()
    Dim myRange As Range, myCopy As Variant
    Dim pvar As Double
    Set myRange = Selection
    CopyVals myRange, myCopy
    pvar = 0.9
    Multiply myRange, pvar
    pvar = 1.1
    RestoreVals myRange, myCopy
    Multiply myRange, pvar
End Sub
注意test() 的最后两行不能将折叠为
RestoreVals myRange, myCopy * pvar

因为这将涉及到一个数组乘以一个双类型不匹配

相关内容

  • 没有找到相关文章

最新更新