当前位置：首页 → 问答吧 → 用VBA实现不同的列加上不同的值

用VBA实现不同的列加上不同的值

时间：2011-08-06

来源：互联网

用VBA实现不同的列加上不同的值，详细说明见附件，求一段VBA代码，如果函数可以实现也可以，谢谢。

附件

不同的列赋予不同的值.zip(6.38 KB)

2011-8-6 20:31, 下载次数: 16

作者: kay520042 发布时间: 2011-08-06

有什么实际的应用例子吗？
你的要求象绕口令，而且有点乱，很难理解。

作者: 蓝桥玄霜发布时间: 2011-08-06

水平有限，按你的描述思路写的

复制内容到剪贴板

代码:

Sub aa()
Dim arr, i%, mm%, a%, b%, c%, d%
arr = Range("d2", [h65536].End(3))
For i = 1 To UBound(arr)
      a = Abs(arr(i, 5) - arr(i, 1))
      b = Abs(arr(i, 5) - arr(i, 2))
      c = Abs(arr(i, 5) - arr(i, 3))
      d = Abs(arr(i, 5) - arr(i, 4))
      mm = Application.Min(a, b, c, d)


      If mm = a Then
         Cells(i + 1, 9) = arr(i, 1) + 10
      ElseIf mm = b Then
         Cells(i + 1, 9) = arr(i, 2) + 20
      ElseIf mm = c Then
         Cells(i + 1, 9) = arr(i, 3) + 30
      ElseIf mm = d Then
         Cells(i + 1, 9) = arr(i, 4) + 40
      End If
Next
End Sub

作者: flysum2008 发布时间: 2011-08-06

复制内容到剪贴板

代码:

Sub 结果()
Dim Arr, d As Object, i&, x(1 To 5) As Variant, j%
Set d = CreateObject("scripting.dictionary")
Arr = Range("d1").CurrentRegion
For i = 2 To UBound(Arr)
For j = 1 To 4
   x(j) = Abs(Arr(i, j) - Arr(i, 5))
Next
x(5) = Application.WorksheetFunction.Small(Array(x(1), x(2), x(3), x(4)), 1)
For j = 1 To 4
   If x(5) = x(j) Then
   d(i - 2) = Arr(i, j) + 10 * j
   End If
Next
[i2].Resize(d.Count) = Application.Transpose(d.items)
Next
End Sub

[ 本帖最后由陈国华于 2011-8-6 22:33 编辑 ]

作者: 陈国华发布时间: 2011-08-06

谢谢lysum2008 ，你的代码实现了我所需要的功能，但是出现了一个问题，如果出现了两个相同的绝对值怎么办？
取第一次出现的吗？？

作者: kay520042 发布时间: 2011-08-06

你可以通过改数值的方法得到测试结果。比如数值2和数值3的绝对值一样，取数值2

作者: flysum2008 发布时间: 2011-08-06