怎么筛选出相同单据

yaozong

参考附件                    

kuaile_xiawa

yaozong 发表于 2019-10-9 08:47
参考附件

附件里好像就只有我的原稿   没有结果
我重新再更新了下 附件
麻烦帮忙看下  

yaozong

kuaile_xiawa 发表于 2019-10-9 09:08
附件里好像就只有我的原稿   没有结果
我重新再更新了下 附件
麻烦帮忙看下

你把数据清除（第2行），再运行程序看看。

因为程序结果与你的模似结果一致，所以........

yaozong

  。。。。。。。。。。。。。。。。。。。。。。。                                                   

kuaile_xiawa

yaozong 发表于 2019-10-9 12:59
。。。。。。。。。。。。。。。。。。。。。。。                                                     ...

你这个模板是可以把单号分成-1，-2，-3的显示出来
可不可以再加个条件：把没分成-1，-2的同工序同单号也显示出来
因为有时单据一多，会重复输入   附件我有新上传

yaozong

kuaile_xiawa 发表于 2019-10-9 13:44
你这个模板是可以把单号分成-1，-2，-3的显示出来
可不可以再加个条件：把没分成-1，-2的同工序同单号也 ...

Option Explicit

Sub test()
Dim d, arr, s$, i&, j&, k, t, m&
Set d = CreateObject("Scripting.Dictionary")
arr = Sheets("Sheet1").[a1].CurrentRegion.Value
ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2) + 1)
For i = 2 To UBound(arr)
  If InStr(arr(i, 2), "-") > 0 Then
    arr(i, 2) = Trim(Left(arr(i, 2), InStr(arr(i, 2), "-") - 1))
  End If
  s = arr(i, 1) & Trim(arr(i, 2))
  If Not d.exists(s) Then
    d(s) = Array(arr(i, 1), arr(i, 2), arr(i, 3), 1)
  Else
    t = d(s)
    t(2) = t(2) + arr(i, 3)
    t(3) = t(3) + 1
    d(s) = t
  End If
Next
m = 1
brr(m, 1) = "工序": brr(m, 2) = "单号": brr(m, 3) = "数量": brr(m, 4) = "次数"
For Each k In d.items
  If k(3) > 1 Then
    m = m + 1
    For j = 0 To 3
      brr(m, j + 1) = k(j)
    Next
  End If
Next
With Sheets("2")
  .[a11].CurrentRegion.ClearContents
  If m > 0 Then .[a11].Resize(m, 4) = brr
End With
End Sub

yaozong

参考附件。。。。。。。

kuaile_xiawa

yaozong 发表于 2019-10-9 15:47
参考附件。。。。。。。

达到预期效果，EXCE实在是太强大了
可不可以再帮忙调节下   按下钮 结果显示  从第一行开始  目前是显示在第11行

yaozong

kuaile_xiawa 发表于 2019-10-9 17:00
达到预期效果，EXCE实在是太强大了
可不可以再帮忙调节下   按下钮 结果显示  从第一行开始  目前是显 ...

照你的级别与进入论坛10年的经历，相信会调整运行结果的存放点。
自已要多实践操作............

kuaile_xiawa

yaozong 发表于 2019-10-9 17:17
照你的级别与进入论坛10年的经历，相信会调整运行结果的存放点。
自已要多实践操作............

哎 我对VBA其实真的不懂  只知道它比公式更方便快捷，
麻烦下喽