楼主
kevinchengcw |
Q: 如何利用vba代码根据特征字符对工序进行分类？
A: 规则如下：
实现代码如下：
- Sub test()
- Dim Rules, Dic As Object, Arr, Result, N&, I%, T%, Str$
- Rules = Split("数控,清,|数控|机器人,清,|机器人|划,卧铣,|卧铣|划,立铣,|立铣|割,清,|割|划,钻,钳,|钻|划,钻,|钻|钻,钳,|钻|划,镗,|镗|划,镗,钳,|镗|拼装,定位焊,|拼装", "|") '设定规则数组
- '规则样式:
- '工作中心1,工作中心2,|新工作中心
- '"|"前面是工序组合，每个工序后面要加个","，"|"后面是在新工作中心中的名称，以上为一组，每组之间再以"|"分隔
- Set Dic = CreateObject("scripting.dictionary") '创建字典项目,用于装载规则,加快处理速度
- For N = LBound(Rules) To UBound(Rules) Step 2 '循环将规则添加到字典中
- Dic(Rules(N)) = Rules(N + 1)
- Next N
- Arr = Range("A2:F" & Cells(Rows.Count, "F").End(3).Row).Value '读取源数据区域到数组中
- ReDim Result(LBound(Arr) To UBound(Arr), 1 To 1) '重定义结果数组与源数据区行数相同
- For N = LBound(Arr) To UBound(Arr) '循环源数据区各行
- If Trim(Arr(N, 6)) = "矫" Then '如果当前工作中心文本是"矫"字,则查看字典中是否存在该物料编号,有则将次数加1,无则添加
- If Dic.exists(Arr(N, 1)) Then
- Dic(Arr(N, 1)) = Dic(Arr(N, 1)) + 1
- Else
- Dic(Arr(N, 1)) = 1
- End If
- Result(N, 1) = WorksheetFunction.Text(Dic(Arr(N, 1)), "[DBNum1]d矫") '根据当前字典计数值转换成中文大写数字写入结果数组对应项目中
- Else '如果不是"矫"字,则
- For T = 2 To 0 Step -1 '循环三次,从三个组合到一个,以匹配最长组合结果
- Str = "" '初始化字符串为空值
- For I = 0 To T '循环提取数组中对应项目
- If N + I <= UBound(Arr) Then '如果未超出源数据数组范围,则串接项目内容并以","分隔
- Str = Str & Trim(Arr(N + I, 6)) & ","
- Else '否则退出循环
- Exit For
- End If
- Next I
- If Dic.exists(Str) Then '如果字典中有当前字符串项目存在,则将对应的item内容写入对应的结果数组项目中
- For I = 0 To T
- If N + I <= UBound(Arr) Then
- Result(N + I, 1) = Dic(Str)
- Else
- Exit For
- End If
- Next I
- N = N + T '跳过已处理好的数据区
- Exit For '跳出循环
- End If
- Next T
- End If
- Next N
- With [i2] '清空目标区内容,并写入结果
- .EntireColumn.ClearContents
- .Resize(UBound(Result)) = Result
- End With
- Set Dic = Nothing '清空字典项目
- End Sub
详见附件及素材源帖。
 工序合并.rar
|