请问如何搜索比较数值大小

leobu · 发表于 2020-1-7 11:08

各位高手，有问题请教：

如图1所示，B列和F列是原始数据列，这两列数字都是从第10行开始，但是结束行数不固定，本例中是在第24行结束。

现在需要首先在F列从下到上搜寻非零的数值，例如在F列的F24单元格有一个数值为3，然后在B列搜寻行号不大于24的最近的两个非零值，依次分别是11和17，由于11小于17，这时需要在G24单元格写入-1；

类似地，在F列的F21单元格有一个非零数值为1.5，那么在B列搜寻行号不大于21行的最近的两个非零值，依次分别是17和15，由于17大于15，这时需要在G21单元格写入1；

依此类推。

需要说明的是，F12单元格虽然也有非零数值5，但是B列中行号不大于12的非零数值仅有B11单元格的36，这里无法进行比较，此时仅需在G12单元格写入1即可。

最后得出的计算结果如图2所示。

这样的工作表有数百个，请问如何使用VBA实现自动比较计算？

非常感谢！

hfwufanhf2006 · 发表于 2020-1-7 15:22

我去帮你做下，你先等着。

hfwufanhf2006 · 发表于 2020-1-7 15:47

代码写好了，楼主去验证。
目前的代码只能判断当前工作表，如果要对很多表做判断，还需要再套一层循环，遍历所有工作表：

Range("g:g").ClearContents                      '先清除G列，以后修改F列的数字就可以重复判断

For i = 10 To [f65000].End(3).Row             '循环f的所有行
If Cells(i, "f") <> 0 Then                      'f列为零的过滤掉
   s1 = 0                                              's1和s2是两个存储b列值的变量，初始化为零
   s2 = 0
   js = 0                                              '计数器
   For k = i To 10 Step -1                      '对b列进行倒循环,从i行到第10行，变量k初始值k=i
         If js = 2 Then                               '只记录两个数，计数器=2退出循环
            Exit For
         End If
         If (Cells(k, 2) <> 0) Then             '只对b列不为零的进行处理
            If js = 0 Then                            '计数器=0，计录第一个数字
               s1 = Cells(k, 2)
               js = js + 1
            Else                                           '计数器<>0表示是记录第二个数，计数器最大也就是1
               s2 = Cells(k, 2)
               js = js + 1
            End If
         End If
   Next k

   If (s1 <> 0) And (s2 <> 0) Then          '两个变量都有数字
      If s1 > s2 Then                               '判断大小
         Cells(i, "g") = 1                            '在i行的g列写入
      Else
         Cells(i, "g") = -1                            '写入另一种判断结果
      End If
   Else
      if s1<>0 then                                  '要防止b列所有数字都是零，都是零就不写入任何数
         Cells(i, "g") = 1                            '只有一个数字的情况，第二个数字是零
      endif
   End If
End If
Next i

cui26896 · 发表于 2020-1-7 19:37

Sub test()
Dim i&, arr, j&, m&, rowmax, a, b, s, brr, k, s1, s2
  rowmax = Sheets(1).UsedRange.Rows.Count
  ReDim brr(1 To rowmax - 9, 1 To 1)
  a = [b10].Resize(rowmax - 9).Address
  b = [f10].Resize(rowmax - 9).Address
  s = "choose({1,2}," & a & "," & b & ")"
  arr = Evaluate(s)
  For i = UBound(arr) To 1 Step -1
k = 0: s1 = 0: s2 = 0
If arr(i, 2) <> 0 Then
   For j = i To 1 Step -1
      If k = 1 Then Exit For
      If arr(j, 1) <> 0 Then
      s1 = arr(j, 1)
      For m = j - 1 To 1 Step -1
         If j - 1 = 1 Then brr(i, 1) = 1: Exit For
         If arr(m, 1) <> 0 Then
            If k = 1 Then Exit For
            s2 = arr(m, 1): k = 1
            If s2 > s1 Then
            brr(i, 1) = -1
            Else
               brr(i, 1) = 1
            End If
         End If
      Next
      End If
   Next
End If
  Next
  Sheet1.Range("g10").Resize(rowmax - 9, 1) = brr
End Sub

大灰狼1976 · 发表于 2020-1-7 20:16

Sub test()
Dim arr, arr1, i&, j&, n&
arr = [f10].CurrentRegion.Offset(, -4).Resize(, 5)
ReDim arr1(1 To UBound(arr), 0)
For i = UBound(arr) To 1 Step -1
If arr(i, 5) Then
n = 0
For j = i To 1 Step -1
If arr(j, 1) Then If n = 0 Then n = arr(j, 1) Else arr1(i, 0) = (n < arr(j, 1)) * 2 + 1: Exit For
Next j
If j = 0 Then arr1(i, 0) = 1
End If
Next i
[g10].Resize(UBound(arr)) = arr1
End Sub

复制代码

cui26896 · 发表于 2020-1-7 20:37

大灰狼1976 发表于 2020-1-7 20:16

构思更巧妙，不愧是版主，水平就是高啊！

cui26896 · 发表于 2020-1-7 21:02

大灰狼1976 发表于 2020-1-7 20:16

If arr(i, 5) Then，If arr(j, 1) Then是arr(i, 5) ，arr(j, 1)不为零的意思吗？从来没见过这种用法

大灰狼1976 · 发表于 2020-1-8 09:25

是的，就这个意思，这都是些障眼法，无足挂齿。

leobu · 发表于 2020-1-8 10:12

cui26896 发表于 2020-1-7 19:37
Sub test()
Dim i&, arr, j&, m&, rowmax, a, b, s, brr, k, s1, s2
rowmax = Sheets(1).UsedRange.Row ...

抱歉回复晚了，非常感谢您的帮助，您的代码我正在学习中

leobu · 发表于 2020-1-8 10:15

大灰狼1976 发表于 2020-1-7 20:16

版主真是大神啊，多谢多谢！

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