判断区间问题

2083849085

有个问题想了好久，实在不知道怎么弄，方向都没搞明白，我现在是通过vba来处理，所以就放到vba的板块了，函数不知道是否也同样能解决。问题如下：
假设公司分5个薪级，每个薪级是薪酬带宽较大，只有起薪值跟上限值，现在根据现有人员的收入，判断其所处的所有可能的薪级。（薪酬带宽重叠度较高，有可能一个工资水平对应可以落在3个薪级）见附件。由于现有人员较多，手工判断不现实，函数又想不到怎么处理。
我自己的想法是：由于列是固定的，将行设为变量，通过同个人的收入循环对比，每对比一次，位于区间内的就返回薪级，将所有薪级组成数组，之后利用join函数集合在一块。

1. Sub 套改()
   
2. Dim x, y, z As Integer, arr()
   
3. x = Cells(Rows.Count, 8).End(xlUp)
   
4. For z = 2 To x
   
5. For y = 2 To 6
   
6. If Cells(z, 8) >= Cells(y, 2) And Cells(z, 8) <= Cells(y, 3) Then
   
7. t = Cells(y, 1)
   
8. a = a + 1
   
9. arr(a) = t
   
10. ReDim Preserve arr(a)
    
11. Cells(z, 9) = arr(a).Join(",")
    
12. Next y
    
13. Next z
    
14. End Sub

复制代码

请高手指点迷津！

smhf_6

Sub 套改()
Dim x, y, z As Integer, temp
x = Range("h60000").End(xlUp).Row
For z = 2 To x
For y = 2 To 6
    If Cells(z, 8) >= Cells(y, 2) And Cells(z, 8) <= Cells(y, 3) Then
     ' 或者 If Application.Median(Cells(y, 2), Cells(y, 3), Cells(z, 8)) = Cells(z, 8) Then
    temp = temp & "," & Cells(y, 1)
    End If
Next y
Cells(z, 9) = Mid(temp, 2)
temp = ""
Next z
End Sub

liulang0808

1. Sub 按钮1_Click()
   
2.     Application.ScreenUpdating = False
   
3.     arr = [a1].CurrentRegion
   
4.     brr = [h1].CurrentRegion
   
5.     For j = 2 To UBound(brr)
   
6.         For i = 2 To UBound(arr)
   
7.             If brr(j, 1) >= arr(i, 2) And brr(j, 1) <= arr(i, 3) Then
   
8.                 brr(j, 2) = arr(i, 1)
   
9.                 Exit For
   
10.             End If
    
11.         Next i
    
12.     Next j
    
13.     [h1].CurrentRegion = brr
    
14.     Application.ScreenUpdating = True
    
15. End Sub
    

复制代码

liulang0808

附件内容供参考。。。。。。

鱼333

Cells(z, 9) = Mid(temp, 2)，Mid(temp, 2)MID函数提取的是什么？大师这一句没明白，请大师解释一下谢谢！

快乐的罗非鱼

我在立即窗口查看第一个值是（“，1” ） MID提取的是1，第二个值是（“，4,3”）MID提取的是4，不应该是4,3.请大师解惑。谢谢啦！

2083849085

liulang0808 发表于 2018-7-13 08:04
附件内容供参考。。。。。。

测试过，发现只能显示其中一个级别，不能全显示，后来我放弃用数组了，我直接单元格=单元格&“，”&返回级别的方式来实现累加：

1. Sub 套改()
   
2. Dim x, y, z As Integer
   
3. x = [h100].End(xlUp).Row
   
4. Range(Cells(2, 9), Cells(x, 9)).ClearContents
   
5. For z = 2 To x
   
6. For y = 2 To 6
   
7. If Cells(z, 8) >= Cells(y, 2) And Cells(z, 8) <= Cells(y, 3) Then
   
8. Cells(z, 9) = Cells(z, 9) & "," & Cells(y, 1)
   
9. End If
   
10. Next y
    
11. Next z
    
12. End Sub

复制代码

2083849085

一开始用cells（z,9)=cells(z,9)&cells(y,1)，但是级别会重复出现，不知道为什么，所以改用数组，后来数组不会弄，又回过头来用单元格累加的方式，发现在中间加个&“，”之后就不会出现级别反复出现的情况。

lsdongjh

各级别区间存在重叠，请明确 取值原则：是就高不就低，还是咋 的？如果明确，不需要双重判断的

lsdongjh

1. Sub Test()
   
2.     Dim arrSource As Variant, arrResult As Variant
   
3.     Dim lngRow_R As Long, lngRow_S As Long
   
4.     Dim lngVal As Long
   
5.    
   
6.     arrSource = Sheet1.Range("A2:C6")
   
7.     Sheet1.Range("I2:I8").ClearContents
   
8.     arrResult = Sheet1.Range("H2:I8")
   
9.    
   
10.     For lngRow_S = LBound(arrResult) To UBound(arrResult)
    
11.         lngVal = arrResult(lngRow_S, 1)
    
12.         For lngRow_R = UBound(arrSource) To LBound(arrSource) Step -1
    
13.             If lngVal >= arrSource(lngRow_R, 2) And lngVal <= arrSource(lngRow_R, 3) Then
    
14.                 arrResult(lngRow_S, 2) = arrResult(lngRow_S, 2) & arrSource(lngRow_R, 1) & ","
    
15.             End If
    
16.         Next
    
17.     Next
    
18.    
    
19.     Sheet1.Range("H2:I8") = arrResult
    
20. End Sub
    

复制代码