数组中的空值-VBA

嗨，我有一个三次样条插值函数，当我在向量x或y上有空单元格时，我很难使用它。在其他情况下，如果X向量或Y向量包含空值，我需要两个数组“冷凝”以保持彼此的对应关系。你们能帮帮我吗

例： 请看这里的例子

向量应为：

x   5   28  49  111 133 194 214 235 256

y   2.15    2.154   2.11    2.065   2.05    2.21    2.354   2.347   2.45

    

代码

公共函数CubicSplineH（ByVal Xarray作为量程，ByVal Yarray作为量程，ByVal q作为双精度）
Dim周期\u计数为整数
Dim rate_计数为整数
period_count=Xarray.Columns.count
rate\u count=Yarray.Columns.count
如果周期计数率计数，则
CubicSplineH=“错误：范围计数不匹配”
转到endnow
如果结束
将新（周期计数）重拨为单个
ReDim Yin（周期计数）为单个
作为整数的Dim C
对于C=1到周期计数
Xin（C）=Xarray（C）
尹（C）=雅雷（C）
下一个C
作为整数的Dim N
作为整数的Dim i，K
尺寸P、qn、sig、un为单个
将u（周期计数-1）重拨为单个
重拨yt（周期计数）为单个
N=周期计数
yt（1）=0
u（1）=0
对于i=2到N-1
sig=（Xin（i）-Xin（i-1））/（Xin（i+1）-Xin（i-1））
P=sig*yt（i-1）+2
yt（i）=（sig-1）/P
u（i）=（阴（i+1）-阴（i））/（心（i+1）-心（i））-（阴（i）-阴（i-1））/（心（i）-心（i-1））
u（i）=（6*u（i）/（Xin（i+1）-Xin（i-1））-sig*u（i-1））/P
接下来我
qn=0
un=0
yt（N）=（un-qn*u（N-1））/（qn*yt（N-1）+1）
对于K=N-1到1步骤-1
yt（K）=yt（K）*yt（K+1）+u（K）
下一个K
Dim klo，khi为整数
将h、b、a调暗为单个
双色
klo=1
khi=N
做
K=khi-klo
如果Xin（K）>q，那么
khi=K
其他的
klo=K
如果结束
K=khi-klo
当K>1时循环
h=Xin（khi）-Xin（klo）
a=（Xin（khi）-q）/h
b=（q-Xin（klo））/h
y=a*Yin（klo）+b*Yin（khi）+（a^3-a）*yt（klo）+（b^3-b）*yt（khi））*（h^2）/6
CubicSplineH=y
现在结束：
端函数

编辑：

Sub Test()
    Dim nArrayCount As Long
    Dim rngX As Range
    Dim rngY As Range
    Dim xArray() As Long
    Dim yArray() As Double
    Dim indexer As Long
    Dim iterator As Long
    
    'This is the range of values, to be condensed
    Set rngX = Range("A1:M1")
    Set rngY = Range("A2:M2")
    
    'Start with the width of the range, including blank.
    'The code assumes that both x and y range have the same
    'number of cells. If this isn't the case, you may
    'need some logic to support that.
    nArrayCount = rngX.Columns.Count
    
    'Resize the array to the full width of the range
    ReDim xArray(nArrayCount)
    ReDim yArray(nArrayCount)
    
    'Init the indexer to 0 or 1 (depending on what base
    'you are using for your arrays)
    indexer = 1
    
    For i = 0 To nArrayCount - 1
        If rngX.Range("A1").Offset(, i).Value <> "" _
            And rngY.Range("A1").Offset(, i).Value <> "" Then
            
            xArray(indexer) = rngX.Range("A1").Offset(, i).Value
            yArray(indexer) = rngY.Range("A1").Offset(, i).Value
            
            indexer = indexer + 1
        End If
    Next i
    
    'Now that the array has been filled, redimension it
    'to remove any of the empty elements
    ReDim Preserve xArray(indexer - 1)
    ReDim Preserve yArray(indexer - 1)
    
    'Just a test to make sure it worked
    For i = LBound(xArray) To UBound(xArray)
        Debug.Print xArray(i) & " --> " & yArray(i)
    Next i
End Sub

下面的代码将创建一个数组，大小与输入范围相符，同时忽略空格。我评论它是为了引导你走上正确的方向。看一看，让我们知道你的方向是否正确

Sub Test()
    Dim nArrayCount As Long
    Dim inputRange As Range
    Dim theArray() As Long
    Dim indexer As Long
    Dim cel As Range
    
    'This is the range of values, to be condensed
    Set inputRange = Range("A1:M1")
    
    'Determine the number of non-blank elements in the range
    nArrayCount = Application.WorksheetFunction.Count(inputRange)
    ReDim theArray(nArrayCount)
    
    'Init the indexer to 0 or 1 (depending on what base
    'you are using for your arrays)
    indexer = 1
    
    'Loop over the entire range, ignoring the blanks
    For Each cel In inputRange
        If cel.Value <> "" Then
            theArray(indexer) = cel.Value
            
            'increment the indexer
            indexer = indexer + 1
        End If
    Next cel
    
    'Just a test to make sure it worked
    For i = LBound(theArray) To UBound(theArray)
        Debug.Print theArray(i)
    Next i
End Sub

子测试（）
暗淡的光线与长的光线相同
Dim inputRange As范围
使阵列变暗（）尽可能长
模糊索引器
暗淡的cel As范围
'这是要压缩的值的范围
设置输入范围=范围（“A1:M1”）
'确定范围中非空白元素的数量
nArrayCount=Application.WorksheetFunction.Count（inputRange）
重播阵列（纳雷计数）
'将索引器初始化为0或1（取决于基数
'您正在为您的阵列使用）
索引器=1
'在整个范围内循环，忽略空白
对于输入范围中的每个cel
如果单元格值为“”，则
数组（索引器）=单元格值
'增加索引器
索引器=索引器+1
如果结束
下一个细胞
“只是一个测试，以确保它的工作
对于i=LBound（theArray）到UBound（theArray）
调试。打印阵列（i）
接下来我
端接头

编辑：

Sub Test()
    Dim nArrayCount As Long
    Dim rngX As Range
    Dim rngY As Range
    Dim xArray() As Long
    Dim yArray() As Double
    Dim indexer As Long
    Dim iterator As Long
    
    'This is the range of values, to be condensed
    Set rngX = Range("A1:M1")
    Set rngY = Range("A2:M2")
    
    'Start with the width of the range, including blank.
    'The code assumes that both x and y range have the same
    'number of cells. If this isn't the case, you may
    'need some logic to support that.
    nArrayCount = rngX.Columns.Count
    
    'Resize the array to the full width of the range
    ReDim xArray(nArrayCount)
    ReDim yArray(nArrayCount)
    
    'Init the indexer to 0 or 1 (depending on what base
    'you are using for your arrays)
    indexer = 1
    
    For i = 0 To nArrayCount - 1
        If rngX.Range("A1").Offset(, i).Value <> "" _
            And rngY.Range("A1").Offset(, i).Value <> "" Then
            
            xArray(indexer) = rngX.Range("A1").Offset(, i).Value
            yArray(indexer) = rngY.Range("A1").Offset(, i).Value
            
            indexer = indexer + 1
        End If
    Next i
    
    'Now that the array has been filled, redimension it
    'to remove any of the empty elements
    ReDim Preserve xArray(indexer - 1)
    ReDim Preserve yArray(indexer - 1)
    
    'Just a test to make sure it worked
    For i = LBound(xArray) To UBound(xArray)
        Debug.Print xArray(i) & " --> " & yArray(i)
    Next i
End Sub

下面的代码将创建一个数组，大小与输入范围相符，同时忽略空格。我评论它是为了引导你走上正确的方向。看一看，让我们知道你的方向是否正确

Sub Test()
    Dim nArrayCount As Long
    Dim inputRange As Range
    Dim theArray() As Long
    Dim indexer As Long
    Dim cel As Range
    
    'This is the range of values, to be condensed
    Set inputRange = Range("A1:M1")
    
    'Determine the number of non-blank elements in the range
    nArrayCount = Application.WorksheetFunction.Count(inputRange)
    ReDim theArray(nArrayCount)
    
    'Init the indexer to 0 or 1 (depending on what base
    'you are using for your arrays)
    indexer = 1
    
    'Loop over the entire range, ignoring the blanks
    For Each cel In inputRange
        If cel.Value <> "" Then
            theArray(indexer) = cel.Value
            
            'increment the indexer
            indexer = indexer + 1
        End If
    Next cel
    
    'Just a test to make sure it worked
    For i = LBound(theArray) To UBound(theArray)
        Debug.Print theArray(i)
    Next i
End Sub

子测试（）
暗淡的光线与长的光线相同
Dim inputRange As范围
使阵列变暗（）尽可能长
模糊索引器
暗淡的cel As范围
'这是要压缩的值的范围
设置输入范围=范围（“A1:M1”）
'确定范围中非空白元素的数量
nArrayCount=Application.WorksheetFunction.Count（inputRange）
重播阵列（纳雷计数）
'将索引器初始化为0或1（取决于基数
'您正在为您的阵列使用）
索引器=1
'在整个范围内循环，忽略空白
对于输入范围中的每个cel
如果单元格值为“”，则
数组（索引器）=单元格值
'增加索引器
索引器=索引器+1
如果结束
下一个细胞
“只是一个测试，以确保它的工作
对于i=LBound（theArray）到UBound（theArray）
调试。打印阵列（i）
接下来我
端接头

您是否有调用

CubicSplineH

的测试例程及其用于生成输出的数据？如果在创建输出时跳过单元格，则该位代码中更可能出现错误。我认为空白单元格包含零作为值，这会在混合类型中创建不正确的值？Excel本机数字是

Double

而不是

Single

，本机整数类型实际上是

Long

而不是

integer

。在VBA中，Integer是一个16位有符号整数，最高可达36767，然后溢出。该问题不需要hole子例程。你真正想要的是把一个有空单元格的区域转换成一个密集的数组用于数学。我真的不认识John，谢谢你的强调。我还在学习，我有一段代码，我用三次样条函数插值利率，我没有写。正如你所说，我想将它调整为密集阵列。也许我应该从头开始重新编写它，我只是不知道该怎么做。您是否有一个调用

CubicSplineH

的测试例程，以及它用来生成输出的数据？如果在创建输出时跳过单元格，则该位代码中更可能出现错误。我认为空白单元格包含零作为值，这会在混合类型中创建不正确的值？Excel本机数字是

Double

而不是

Single

，本机整数类型实际上是

Long

而不是

integer

。在VBA中，Integer是一个16位有符号整数，最高可达36767，然后溢出。该问题不需要hole子例程。你真正想要的是把一个有空单元格的区域转换成一个密集的数组

Sub Test()
    Dim nArrayCount As Long
    Dim inputRange As Range
    Dim theArray() As Long
    Dim indexer As Long
    Dim cel As Range
    
    'This is the range of values, to be condensed
    Set inputRange = Range("A1:M1")
    
    'Determine the number of non-blank elements in the range
    nArrayCount = Application.WorksheetFunction.Count(inputRange)
    ReDim theArray(nArrayCount)
    
    'Init the indexer to 0 or 1 (depending on what base
    'you are using for your arrays)
    indexer = 1
    
    'Loop over the entire range, ignoring the blanks
    For Each cel In inputRange
        If cel.Value <> "" Then
            theArray(indexer) = cel.Value
            
            'increment the indexer
            indexer = indexer + 1
        End If
    Next cel
    
    'Just a test to make sure it worked
    For i = LBound(theArray) To UBound(theArray)
        Debug.Print theArray(i)
    Next i
End Sub