很复杂的查询调用，感觉函数已经解决不了了- -，求助

AA13714007

先对工序判断，再根据零件的直径参数和长度参数找到对应范围的工价。每个工序的参数范围还不一样。。。自己解决不了- -求助

jsgj2023

每道工序都单独建立一个工作表可能更便于操作!

chxw68

这个问题确实还是比较复杂的。

DADAYU

抱歉之前有点理解错误了，我重新看了表格，这个代码对我来说工作量挺大的。。。汗颜了
设计思路，用function编写
1、读取工序列内容；
2、在worksheets（"工序价格表"）中查找对应工序名称找到对应单元格；
3、用CurrentRegion确定工序对应工价表并用一个range常量保存；
4、如果对应工价表有价格区间，先查找字符“-”位置，用该位置把数值分为上下限，并分别保存在数组min（）和max（）中；
5、如果产品型号格式类似280*2865，也需按照4的方法，把型号数值放入两个integer变量；
6、分别比对各型号、零件在对应共价表中的行列；
7、最后用cells引用该行列数值赋值给记功表单价中。

一把小刀闯天下

'流水代码，数据量大估计效率较差
'写完再也不想看了，自己试一下

Option Explicit

Sub test()
  Dim arr, brr, i, j, k, t1, t2, pos, crr
  With Sheets("工序价格表")
    arr = .Range("a1:h" & .Cells(Rows.Count, "b").End(xlUp).Row)
  End With
  With Sheets("记工表")
    brr = .Range("b2:d" & .Cells(Rows.Count, "b").End(xlUp).Row)
    ReDim crr(1 To UBound(brr, 1), 1 To 1)
    For i = 1 To UBound(brr, 1)
      If Len(brr(i, 1)) > 0 And Len(brr(i, 3)) > 0 Then
        For j = 1 To UBound(arr, 1)
          If brr(i, 3) = arr(j, 1) Then Exit For
        Next
        If j < UBound(arr, 1) + 1 Then
          pos = j
          If InStr(brr(i, 1), "*") Then
            t2 = Split(brr(i, 1), "*")
            For j = pos + 1 To UBound(arr, 1)
              If Len(arr(j, 1)) = 0 Then Exit For
              t1 = Split(arr(j, 1), "-")
              If Val(t2(0)) >= Val(t1(0)) And Val(t2(0)) <= Val(t1(1)) Then
                For k = 2 To UBound(arr, 2)
                  If Len(arr(pos, k)) = 0 Then Exit For
                  t1 = Split(arr(pos, k), "-")
                  If Val(t2(1)) >= Val(t1(0)) And Val(t2(1)) <= Val(t1(1)) Then
                    crr(i, 1) = arr(j, k): Exit For
                  End If
                Next
              End If
            Next
          Else
            If Len(brr(i, 2)) > 0 Then
              For j = pos + 1 To UBound(arr, 1)
                If Len(arr(j, 1)) = 0 Then Exit For
                t1 = Split(arr(j, 1), "-")
                If Val(brr(i, 1)) >= Val(t1(0)) And Val(brr(i, 1)) <= Val(t1(1)) Then
                  For k = 2 To UBound(arr, 2)
                    If Len(arr(pos, k)) = 0 Then Exit For
                    If brr(i, 2) = arr(pos, k) Then
                      crr(i, 1) = arr(j, k): Exit For
                    End If
                  Next
                End If
              Next
            End If
          End If
        End If
      End If
    Next
    .[f2].Resize(UBound(crr, 1), 1) = crr
  End With
End Sub

一把小刀闯天下

'贴代码怎么老碰到审核的？
复杂的查询调用11.rar (21.69 KB, 下载次数: 13)

2018-1-21 11:51 上传

点击文件名下载附件

chxw68

1. Sub test()
   
2.   Dim r%, i%
   
3.   Dim arr, brr
   
4.   Dim d As Object
   
5.   Set d = CreateObject("scripting.dictionary")
   
6.   With Worksheets("工序价格表")
   
7.     r = .Cells(.Rows.Count, 1).End(xlUp).Row
   
8.     For i = 1 To r
   
9.       If InStr(.Cells(i, 1), "工序") <> 0 Then
   
10.         arr = .Cells(i, 1).CurrentRegion
    
11.         ReDim brr(1 To UBound(arr) + 1, 1 To UBound(arr, 2) + 1)
    
12.         For x = 2 To UBound(arr)
    
13.           crr = Split(arr(x, 1), "-")
    
14.           brr(x + 1, 1) = Val(crr(0))
    
15.           brr(x + 1, 2) = Val(crr(1))
    
16.           For j = 2 To UBound(arr, 2)
    
17.             brr(x + 1, j + 1) = arr(x, j)
    
18.           Next
    
19.         Next
    
20.         For j = 2 To UBound(arr, 2)
    
21.           crr = Split(arr(1, j), "-")
    
22.           If UBound(crr) > 0 Then
    
23.             brr(1, j + 1) = Val(crr(0))
    
24.             brr(2, j + 1) = Val(crr(1))
    
25.             brr(1, 1) = 1
    
26.           Else
    
27.             brr(1, j + 1) = crr(0)
    
28.             brr(1, 1) = 2
    
29.           End If
    
30.         Next
    
31.         d(arr(1, 1)) = brr
    
32.       End If
    
33.     Next
    
34.   End With
    
35.   With Worksheets("记工表")
    
36.     r = .Cells(.Rows.Count, 2).End(xlUp).Row
    
37.     arr = .Range("a2:g" & r)
    
38.     For i = 1 To UBound(arr)
    
39.       If Len(arr(i, 4)) <> 0 Then
    
40.         If d.exists(arr(i, 4)) Then
    
41.           brr = d(arr(i, 4))
    
42.           crr = Split(arr(i, 2), "*")
    
43.           n1 = Val(crr(0))
    
44.           For x = 3 To UBound(brr)
    
45.             If n1 >= brr(x, 1) And n1 <= brr(x, 2) Then
    
46.               Exit For
    
47.             End If
    
48.           Next
    
49.           If UBound(crr) = 1 Then
    
50.             n2 = Val(crr(1))
    
51.             For y = 3 To UBound(brr, 2)
    
52.               If n2 >= brr(1, y) And n2 <= brr(2, y) Then
    
53.                 Exit For
    
54.               End If
    
55.             Next
    
56.           Else
    
57.             n2 = arr(i, 3)
    
58.             For y = 3 To UBound(brr, 2)
    
59.               If brr(1, y) = n2 Then
    
60.                 Exit For
    
61.               End If
    
62.             Next
    
63.           End If
    
64.           If x <= UBound(brr) And y <= UBound(brr, 2) Then
    
65.             arr(i, 6) = brr(x, y)
    
66.           End If
    
67.         End If
    
68.       End If
    
69.     Next
    
70.     .Range("a2:g" & r) = arr
    
71.   End With
    
72. End Sub
    

复制代码

chxw68

对250*2970/3100这样的数据还不能处理，不知道这是什么意思。

一把小刀闯天下

chxw68 发表于 2018-1-21 11:58
对250*2970/3100这样的数据还不能处理，不知道这是什么意思。

老师，这个估计可分拆为250*2970和 250*3100，之前我都没看见，如果是这意思楼主可自行分行。

AA13714007

chxw68 发表于 2018-1-21 11:58
对250*2970/3100这样的数据还不能处理，不知道这是什么意思。

管用了，但能说下思路吗？毕竟我工作用的表还有很多工序- -  我得加进去，也不知道自己能不能改对了