[已解决]用VBA数组查找按下面两种情况改写

laoau138 · 发表于 2017-3-25 21:44

本帖最后由 laoau138 于 2017-3-27 09:25 编辑

用VBA数组查找按下面两种情况改写

最佳答案

雪舞子

2017-3-27 08:32

Sub 找全部()
Dim arr, br(1), x&, y&, t&, i&, s$
arr = Range("a1").CurrentRegion
x = Abs(arr(1, 1) - 99): t = 1
For i = 2 To UBound(arr)
y = Abs(arr(i, 1) - 99)
If x > y Then
x = y: t = i
br(0) = arr(t, 1): br(1) = t
ElseIf x = y Then
br(0) = br(0) & " " & arr(i, 1): br(1) = br(1) & " " & i
End If
Next
For i = 0 To UBound(Split(br(0)))
s = s & vbCrLf & " 单元格地址为 " & Cells(Split(br(1))(i), 1).Address(0, 0) & " 的 " & Split(br(0))(i)
Next
MsgBox "最接近99的数是：" & vbCrLf & s
End Sub

复制代码

雪舞子 · 发表于 2017-3-27 08:32

Sub 找全部()
Dim arr, br(1), x&, y&, t&, i&, s$
arr = Range("a1").CurrentRegion
x = Abs(arr(1, 1) - 99): t = 1
For i = 2 To UBound(arr)
y = Abs(arr(i, 1) - 99)
If x > y Then
x = y: t = i
br(0) = arr(t, 1): br(1) = t
ElseIf x = y Then
br(0) = br(0) & " " & arr(i, 1): br(1) = br(1) & " " & i
End If
Next
For i = 0 To UBound(Split(br(0)))
s = s & vbCrLf & " 单元格地址为 " & Cells(Split(br(1))(i), 1).Address(0, 0) & " 的 " & Split(br(0))(i)
Next
MsgBox "最接近99的数是：" & vbCrLf & s
End Sub

复制代码

雪舞子 · 发表于 2017-3-27 08:57

改进一下第一行最小出错的情况以及通用A列数据为整数小数

Sub 找全部()
Dim arr, br(1), x, y, i&, s$
arr = Range("a1").CurrentRegion
x = Abs(arr(1, 1) - 99): br(0) = arr(1, 1): br(1) = 1
For i = 2 To UBound(arr)
y = Abs(arr(i, 1) - 99)
If x > y Then
x = y: br(0) = arr(i, 1): br(1) = i
ElseIf x = y Then
br(0) = br(0) & " " & arr(i, 1): br(1) = br(1) & " " & i
End If
Next
For i = 0 To UBound(Split(br(0)))
s = s & vbCrLf & " 单元格地址为 " & Cells(Split(br(1))(i), 1).Address(0, 0) & " 的 " & Split(br(0))(i)
Next
MsgBox "最接近99的数是：" & vbCrLf & s
End Sub

复制代码

		自动登录	找回密码
密码			注册