ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
300集Office 2010微视频教程 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 1260|回复: 8

[求助] 【有偿求助】

[复制链接]

TA的精华主题

TA的得分主题

发表于 2018-10-11 00:14 | 显示全部楼层 |阅读模式
1,主要绣球内容见图片描述
2,本帖为有偿帖子,能解决问题的加我的微信18685601873 。
3,我本身也是工程师,但对函数这个领域不太熟悉,我知道应该不难,只是脸薄不想向周围同事请教,所以微信红包就只能发50元
4,交易规则,首先我要先确认所做的函数或者宏能用,然后微信红包付款,嫌钱少的大牛就路过吧。
WeChat Screenshot_20181011000648.png

小区配置表 - 副本.rar

1.22 MB, 下载次数: 30

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-10-11 00:15 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
如果对需求有疑问的请回帖

TA的精华主题

TA的得分主题

发表于 2018-10-11 02:37 | 显示全部楼层
k2=IF(AND(M2=53,OR(I2="D1",I2="D2")),TEXTJOIN("+",,IF((ISNUMBER(FIND($M$2:$M$1438,M2&"/"&(M2+2)&"/"&(M2-2))))*(LEFT($H$2:$H$1438,6)=LEFT(H2,6)),$I$2:$I$438,"")),  TEXTJOIN("+",,IF((ISNUMBER(FIND($M$2:$M$1438,M2&"/"&(M2+3)&"/"&(M2-3))))*(LEFT($H$2:$H$1438,6)=LEFT(H2,6)),$I$2:$I$438,"")) )    数组三键执行后下拉

很想知道你的模拟K27中的模拟结果 “F1+D1+D2+D3”是如何得来的?? 上面的公式的结果和你的不同,只有 “F1”。

TA的精华主题

TA的得分主题

发表于 2018-10-11 08:01 来自手机 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2018-10-11 09:56 | 显示全部楼层
18685601873 发表于 2018-10-11 00:15
如果对需求有疑问的请回帖

请检查验证正确与否?

小区配置表 - 副本.zip

299.69 KB, 下载次数: 8

TA的精华主题

TA的得分主题

发表于 2018-10-11 11:36 | 显示全部楼层
18685601873 发表于 2018-10-11 00:15
如果对需求有疑问的请回帖

后面对于 57   58  59  60  等等怎么处理?什么规则没说啊

TA的精华主题

TA的得分主题

发表于 2018-10-11 12:56 | 显示全部楼层
没有新函数,不是难不难的问题,是麻烦的问题;你去问你同事看看,筛选容易,合并麻烦

TA的精华主题

TA的得分主题

发表于 2018-10-11 14:17 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
本帖最后由 jinlong506 于 2018-10-11 14:37 编辑
micch 发表于 2018-10-11 12:56
没有新函数,不是难不难的问题,是麻烦的问题;你去问你同事看看,筛选容易,合并麻烦

可以自定义 textJoin 函数
  1. Function MyTextJoin(arr As variant, str As String) As String
  2. Dim  i As Integer, j As Integer, s As String, x As Integer, y As Integer
  3.   
  4.   For i = 1 To UBound(arr)
  5.       For j = 1 To UBound(arr, 2)
  6.       
  7.        For x = 1 To i - 1
  8.          For y = 1 To j
  9.            If arr(i, j) = arr(x, y) Then
  10.            arr(i, j) = ""
  11.            End If
  12.            Next y
  13.            Next x
  14.       
  15.         If Len(arr(i, j)) <> 0 Then
  16.         s = s & arr(i, j) & str
  17.         End If
  18.     Next j
  19.     Next i
  20.     MyTextJoin = Left(s, Len(s) - Len(str))
  21.         
  22.         
  23. End Function
复制代码

TA的精华主题

TA的得分主题

发表于 2018-10-14 18:46 | 显示全部楼层
jiaxinl 发表于 2018-10-11 09:56
请检查验证正确与否?
  1. Sub test()
  2. Dim d, dic, arr, brr(), crr, drr(), err, i&, r&, m&, j%, n%, x%, y%, xy%, xy1%, xyy%, s1$, s2$, s3$
  3. Set d = CreateObject("Scripting.Dictionary")
  4. Set d1 = CreateObject("Scripting.Dictionary")
  5. Set d2 = CreateObject("Scripting.Dictionary")
  6. Set dic = CreateObject("Scripting.Dictionary")
  7. Set dic1 = CreateObject("Scripting.Dictionary")
  8. With Sheet1
  9.     r = .[A1].End(xlDown).Row
  10.     .Range("K2:K" & r).ClearContents
  11.     arr = .Range("A2:M" & r)
  12. '    Application.Wait (Now + TimeValue("0:00:03"))
  13.     On Error Resume Next
  14.     m = 0
  15.     ReDim Preserve brr(m)
  16.     brr(m) = 0
  17.     For i = 1 To UBound(arr)
  18.       If arr(i, 2) <> arr(i + 1, 2) Then
  19.       m = m + 1
  20.       ReDim Preserve brr(m)
  21.       brr(m) = i
  22.       End If
  23.     Next
  24.    
  25. '    d("@") = 0
  26. '    For i = 1 To UBound(arr)
  27. '        d(arr(i, 2)) = i
  28. '    Next
  29. '    brr = d.items
  30.    
  31.     For j = 0 To UBound(brr) - 1
  32.         x = x + 1
  33.         ReDim Preserve drr(1 To 2, 1 To x)
  34.         drr(1, x) = brr(j) + 1
  35.         drr(2, x) = brr(j + 1)
  36.     Next
  37.    
  38.    For y = 1 To UBound(drr, 2)
  39.         For xy = drr(1, y) To drr(2, y)
  40.             For xy1 = drr(2, y) To drr(1, y) Step -1
  41.                 If InStr(arr(xy1, 10), "A8712") = 0 Then dic(arr(xy1, UBound(arr, 2))) = dic(arr(xy1, UBound(arr, 2))) & "," & arr(xy1, 9)
  42.                 dic1(arr(xy1, UBound(arr, 2))) = dic1(arr(xy1, UBound(arr, 2))) & "," & arr(xy1, 9)
  43.                 d2(arr(xy1, 9)) = ""
  44.             Next
  45.             
  46.             If InStr(Join(d2.keys, ","), "E") Then
  47.                 For xyy = drr(1, y) To drr(2, y)
  48.                     err = Split(dic1(arr(xyy, UBound(arr, 2))), ",")
  49.                     For n = 1 To UBound(err)
  50.                         d1(err(n)) = ""
  51.                     Next
  52.                     arr(xyy, 11) = Join(d1.keys, "+")
  53.                     Erase err:   d1.RemoveAll
  54.                 Next
  55.             End If
  56.             
  57.             If dic.Exists(53) And InStr(Join(d2.keys, ","), "E") = 0 Then
  58.                  If InStr(dic(53), "D1") Or InStr(dic(53), "D2") Then
  59.                      s1 = "": s2 = "": s3 = ""
  60.                      For f = 51 To 52
  61.                         err = Split(dic(f) & dic(f + 2) & dic(f + 4), ",")
  62.                         For n = 1 To UBound(err)
  63.                             d1(err(n)) = ""
  64.                         Next
  65.                         Select Case f
  66.                             Case 51: s1 = Join(d1.keys, "+")
  67.                             Case 52: s2 = Join(d1.keys, "+")
  68.                         End Select
  69.                         Erase err:   d1.RemoveAll
  70.                      Next
  71.                     For xyy = drr(1, y) To drr(2, y)
  72.                         If InStr(arr(xyy, 10), "A8712") = 0 Then
  73.                             If arr(xyy, UBound(arr, 2)) = 51 Or arr(xyy, UBound(arr, 2)) = 53 Or arr(xyy, UBound(arr, 2)) = 55 Then
  74.                                 arr(xyy, 11) = s1
  75.                             ElseIf arr(xyy, UBound(arr, 2)) = 52 Or arr(xyy, UBound(arr, 2)) = 54 Or arr(xyy, UBound(arr, 2)) = 56 Then
  76.                                 arr(xyy, 11) = s2
  77.                             Else
  78.                                 err = Split(dic(arr(xyy, UBound(arr, 2))), ",")
  79.                                 For n = 1 To UBound(err)
  80.                                     d1(err(n)) = ""
  81.                                 Next
  82.                                 arr(xyy, 11) = Join(d1.keys, "+")
  83.                                 Erase err:   d1.RemoveAll: d2.RemoveAll
  84.                             End If
  85.                         Else
  86.                             err = Split(dic1(arr(xyy, UBound(arr, 2))), ",")
  87.                             For n = 1 To UBound(err)
  88.                                 d1(err(n)) = ""
  89.                             Next
  90.                             arr(xyy, 11) = Join(d1.keys, "+")
  91.                             Erase err:   d1.RemoveAll: d2.RemoveAll
  92.                         End If
  93.                     Next
  94.                  ElseIf InStr(dic(53), "F1") Or InStr(dic(53), "F2") Then
  95.                      s1 = "": s2 = "": s3 = ""
  96.                       For f = 51 To 53
  97.                             err = Split(dic(f) & dic(f + 3), ",")
  98.                             For n = 1 To UBound(err)
  99.                                 d1(err(n)) = ""
  100.                             Next
  101.                             Select Case f
  102.                                 Case 51: s1 = Join(d1.keys, "+")
  103.                                 Case 52: s2 = Join(d1.keys, "+")
  104.                                 Case 53: s3 = Join(d1.keys, "+")
  105.                             End Select
  106.                             Erase err:   d1.RemoveAll
  107.                        Next
  108.                     For xyy = drr(1, y) To drr(2, y)
  109.                         If InStr(arr(xyy, 10), "A8712") = 0 Then
  110.                             If arr(xyy, UBound(arr, 2)) = 51 Or arr(xyy, UBound(arr, 2)) = 54 Then
  111.                                 arr(xyy, 11) = s1
  112.                             ElseIf arr(xyy, UBound(arr, 2)) = 52 Or arr(xyy, UBound(arr, 2)) = 55 Then
  113.                                 arr(xyy, 11) = s2
  114.                             ElseIf arr(xyy, UBound(arr, 2)) = 53 Or arr(xyy, UBound(arr, 2)) = 56 Then
  115.                                 arr(xyy, 11) = s3
  116.                             Else
  117.                                 err = Split(dic(arr(xyy, UBound(arr, 2))), ",")
  118.                                 For n = 1 To UBound(err)
  119.                                     d1(err(n)) = ""
  120.                                 Next
  121.                                 arr(xyy, 11) = Join(d1.keys, "+")
  122.                                 Erase err:   d1.RemoveAll: d2.RemoveAll
  123.                             End If
  124.                         Else
  125.                             err = Split(dic1(arr(xyy, UBound(arr, 2))), ",")
  126.                             For n = 1 To UBound(err)
  127.                                 d1(err(n)) = ""
  128.                             Next
  129.                             arr(xyy, 11) = Join(d1.keys, "+")
  130.                             Erase err:   d1.RemoveAll: d2.RemoveAll
  131.                         End If
  132.                     Next
  133.                 End If
  134.             Else
  135.                 For xyy = drr(1, y) To drr(2, y)
  136.                     err = Split(dic1(arr(xyy, UBound(arr, 2))), ",")
  137.                     For n = 1 To UBound(err)
  138.                         d1(err(n)) = ""
  139.                     Next
  140.                     arr(xyy, 11) = Join(d1.keys, "+")
  141.                     Erase err:   d1.RemoveAll
  142.                 Next
  143.             End If
  144.          Next
  145.          dic.RemoveAll: dic1.RemoveAll: d2.RemoveAll
  146.    Next
  147.    .[K2].Resize(UBound(arr), 1) = Application.WorksheetFunction.Index(arr, 0, 11)
  148. '    .[A2].Resize(UBound(arr), UBound(arr, 2)) = arr
  149. End With
  150. End Sub
复制代码


小区配置表-50元-xxx.zip

356.68 KB, 下载次数: 2

您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-3-29 16:50 , Processed in 0.575262 second(s), 10 queries , Gzip On, Redis On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表