合并问题

ping96055

liulang0808 发表于 2018-8-7 21:21
楼主结合附件说明下，运行结果还差什么？
或者需要怎样的结果

版本，附件已做说明

一把小刀闯天下

'假设 j 列是有序的

Option Explicit

Sub test()
  Dim arr, i, n
  arr = Sheets("sheet1").[a1].CurrentRegion
  ReDim brr(1 To UBound(arr, 1), 1 To 3)
  n = n + 1
  brr(1, 1) = arr(2, 6): brr(1, 2) = arr(2, 10): brr(1, 3) = arr(2, 11)
  For i = 3 To UBound(arr, 1)
    If arr(i, 10) <> arr(i - 1, 10) Then
      n = n + 1
      brr(n, 1) = arr(i, 6): brr(n, 2) = arr(i, 10): brr(n, 3) = arr(i, 11)
    Else
      brr(n, 1) = brr(n, 1) & "/" & arr(i, 6)
    End If
  Next
  With Sheets("sheet2").[d2] '输出位置自己修改
    .Resize(Rows.Count - 1, UBound(brr, 2)).ClearContents
    .Resize(n, UBound(brr, 2)) = brr
  End With
End Sub

ping96055

一把小刀闯天下 发表于 2018-8-8 12:03
'假设 j 列是有序的

Option Explicit

是全部显示出来的，但在生产单号里有重复的值，比如180804-030/180804-028/180804-029/180804-030/180804-028/180804-029,   我只想显示唯 一值，结果应该为180804-030/180804-028/180804-029/

liulang0808

ping96055 发表于 2018-8-8 10:45
版本，附件已做说明

楼主的附件看了，应该是没有问题。
关键是楼具体是什么需求啊？

目前代码是根据第三列为关键字，用字典进行提取的，注意是第三列，第三列不重复数据仅有28个，代码字典读取的最后一个是“85门套线”，查看都没有问题的。

ping96055

liulang0808 发表于 2018-8-8 13:56
楼主的附件看了，应该是没有问题。
关键是楼具体是什么需求啊？

版主，其实我可能没表达清楚，你要以第10列，就是车次颜色型号这列为关键字的。百般打搅，请版主见谅。

liulang0808

ping96055 发表于 2018-8-8 14:15
版主，其实我可能没表达清楚，你要以第10列，就是车次颜色型号这列为关键字的。百般打搅，请版主见谅。

你的代码是按照第三列为关键字的，所有有问题的，楼主自己修改下字典关键对应到第10列即可吧

liulang0808

按照第十列为关键字提取，代码供参考

一把小刀闯天下

ping96055 发表于 2018-8-8 13:41
是全部显示出来的，但在生产单号里有重复的值，比如180804-030/180804-028/180804-029/180804-030/180804 ...

'你也没说，去重就可以了

Option Explicit

Sub test()
  Dim arr, i, j, k, m, n, t
  arr = Sheets("sheet1").[a1].CurrentRegion
  ReDim brr(1 To UBound(arr, 1), 1 To 3)
  n = n + 1
  brr(1, 1) = arr(2, 6): brr(1, 2) = arr(2, 10): brr(1, 3) = arr(2, 11)
  For i = 3 To UBound(arr, 1)
    If arr(i, 10) <> arr(i - 1, 10) Then
      If InStr(brr(n, 1), "/") Then
        t = Split(brr(n, 1), "/"): m = 0
        For j = 0 To UBound(t)
          t(m) = t(j)
          For k = 0 To m - 1
            If t(k) = t(m) Then Exit For
          Next
          If k = m Then m = m + 1
        Next
        ReDim Preserve t(m - 1)
        If UBound(t) > 0 Then
          brr(n, 1) = Join(t, "/")
        Else
          brr(n, 1) = t(0)
        End If
      End If
      n = n + 1
      brr(n, 1) = arr(i, 6): brr(n, 2) = arr(i, 10): brr(n, 3) = arr(i, 11)
    Else
      brr(n, 1) = brr(n, 1) & "/" & arr(i, 6)
    End If
  Next
  With Sheets("sheet2").[d2]
    .Resize(Rows.Count - 1, UBound(brr, 2)).ClearContents
    .Resize(n, UBound(brr, 2)) = brr
  End With
End Sub

ping96055

一把小刀闯天下 发表于 2018-8-8 14:30
'你也没说，去重就可以了

Option Explicit

完美解决，

ping96055

liulang0808 发表于 2018-8-8 14:20
按照第十列为关键字提取，代码供参考

第10列为关键字，没错，但汇总生产单号列有重复。