[已解决]数据合并

一休和尚

各位老师：
下面表格中G列（图号）有相同的图号，相同图号对应的J列内容不同；
要求，G列相同图号合并成一个单元格，J列（反馈不合格内容描述）不同内容合并到一个单元格，中间用分号隔开；
这样子怎么才能达到，表格数据很多，我只是拷贝了一点上来；

序	顾客名称	反馈时间	国内外	反馈分类	产品名称	图号	分类	NC编号	反馈不合格内容描述
3	雪人	1月4日	国内	反馈	机身	533961	接刀痕	无	大端面接刀手感严重
4	JCI	1月4日	国内	投诉	GT188滑阀	064-54252-230	尺寸超差	无	人字弧轮廓度客户测量查查9丝，内部测量超差1丝（存在异常点）
5	JCI	1月5日		客服	CTS151排气座	064W51903-000	钢印错误	无	CTS151排气座064W51903-000,LD-151016,报告与需求相符，实物钢印图号不符，是064W51903-101
6	HUSKY	1月5日	国内	反馈	300油缸	5323643	加工不良	无	是客户现场反馈的问题，请确认下这个坑是否是面铣刀铣削造成的，需要通知技术和车间改善
9	雪人	1月7日	国内	反馈	转子座		滑阀间隙	无	滑阀到滑阀孔底部距离不良
10	雪人	1月7日	国内	反馈	压盖	534041	螺纹深度	无	1/4NPT螺纹深度不足
11	IR	1月7日	国内	反馈	C700配作	22704621	尺寸超差	无	轴承孔尺寸超差
12	JCI	1月8日	国外	投诉	SGC转子座	534E0671	尺寸超差	IRIS-BE-SMRR-16000040	滑阀孔塞规卡死
13	雪人	1月8日	国内	投诉	机身	533936	尺寸超差	2016IQC020001	（1）要求Φ100-0.002/-0.018mm  实测Φ100mm LD150535     （2）要求滑阀段差+0.01/-0.03mm 实测+0.014mm阳转子孔LD151208     （3）滑阀与机身接触面间隙要求小等于0.02mm 实测0.04-0.07mm有4台LD151216/151208/150510/151107
14	雪人	1月8日	国内	投诉	机身	533961	尺寸超差	2016IQC020002	（1）要求T单点76.078+0.01/0mm  实测76.1092mm     （2)要求Φ130-0.002/-0.021mm 实测Φ129.96mm LD151214     （3）要求滑阀与机身接触面间隙小等于0.02mm 实测0.03-0.06mm     （4）段差要求+0.01/-0.03mm实测+0.018mm LD14115002     （5）来料人字形磨损 LD151207 见不良品质报告书照片
15	雪人	1月8日	国内	投诉	机身	533987	尺寸超差	2016IQC020003	（1）要求P单点85.2+0.02/0mm  实测85.2361mm     （2）要求U单点85.2+0.02/0mm 实测85.2471mm     (3)要求Φ273.1+0.03mm 实测Φ273.142mm     (4)要求156±0.02mm 实测155.9677mm     （5）要求156±0.02mm 实测156.0471mm

最佳答案

月排行榜 / 总排行榜

grf1973

2017-7-10 10:21

请看附件。

跳转到最佳答案楼层

chart888

上传附件吧

一休和尚

chart888 发表于 2017-7-8 10:08
上传附件吧

2016年客诉台账.rar (112.89 KB, 下载次数: 6)

2017-7-8 11:05 上传

点击文件名下载附件

以上传附件

chart888

一休和尚 发表于 2017-7-8 11:06
以上传附件

1. Private Sub CommandButton1_Click()
   
2. Dim r, i
   
3. Application.ScreenUpdating = False
   
4. Application.DisplayAlerts = False
   
5. Worksheets("客诉台账").Cells.Copy Worksheets("结果").Cells
   
6. With Worksheets("结果")
   
7.     .Range("A1:j" & .[A65536].End(xlUp).Row).Sort key1:=.[G1], order1:=xlDescending
   
8.     r = .Range("A65536").End(xlUp).Row
   
9.     .Range("G2:G" & r).NumberFormatLocal = "G/通用格式"
   
10.     .Range("G2:G" & r).Value = .Range("G2:G" & r).Value
    
11.     For i = r To 2 Step -1
    
12.         If .Cells(i, 7).Value <> "" Then
    
13.             If .Cells(i, 7).Value = .Cells(i - 1, 7).Value Then
    
14.                 .Range(.Cells(i - 1, 7), .Cells(i, 7)).Merge
    
15.                 s = .Cells(i - 1, 10) & Chr(10) & .Cells(i, 10)
    
16.                 .Range(.Cells(i - 1, 10), .Cells(i, 10)).Merge
    
17.                 .Cells(i - 1, 10) = s
    
18.             End If
    
19.         End If
    
20.     Next
    
21. End With
    
22. Application.ScreenUpdating = True
    
23. Application.DisplayAlerts = True
    
24. End Sub

复制代码

一休和尚

chart888 发表于 2017-7-8 13:09

382	IR	6月11日	国内	反馈	C700配作	49133259	螺纹通止	无	C700齿轮箱箱体箱盖连接螺纹不良问题再次发生     螺纹孔内有油漆     密封空气管1/8NPT 安装不进去。铸件里面堵塞     一处孔装配干涉     C700齿轮箱膜厚超标和外圆打磨过渡
509	IR	8月16日	国内	反馈	C700配作		油漆不良	无
580	IR	9月28日	国外	投诉	C700齿轮箱		铸件堵塞	NCR 20160818
686	IR	11月17日	国外	投诉	C700配作		装配干涉	无
720	IR	12月3日	国内	反馈	C700齿轮箱		打磨伤	无

上面是运行后的合并格式，能否搞成下面这种格式；就是保留第一次的图号就可以了；

382

IR

6月11日

国内

反馈

C700配作

49133259

螺纹通止

无

C700齿轮箱箱体箱盖连接螺纹不良问题再次发生     螺纹孔内有油漆     密封空气管1/8NPT 安装不进去。铸件里面堵塞     一处孔装配干涉     C700齿轮箱膜厚超标和外圆打磨过渡

chart888

一休和尚 发表于 2017-7-8 16:43
上面是运行后的合并格式，能否搞成下面这种格式；就是保留第一次的图号就可以了；

内容不统一
合并后的单元格怎么确定内容呢？

chart888

合并单元格有点多
运行起来有点慢
你试试

grf1973

格式自调。

1. Sub grf()
   
2.     Set d = CreateObject("scripting.dictionary")
   
3.     arr = [a1].CurrentRegion
   
4.     ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2))
   
5.     For i = 1 To UBound(arr)
   
6.         x = arr(i, 7)
   
7.         If Not d.exists(x) Then
   
8.             n = n + 1
   
9.             d(x) = n
   
10.             For k = 1 To UBound(arr, 2)
    
11.                 brr(n, k) = arr(i, k)
    
12.             Next
    
13.         Else
    
14.             brr(d(x), 10) = brr(d(x), 10) & Chr(10) & arr(i, 10)
    
15.         End If
    
16.     Next
    
17.     With Sheets(2)
    
18.         .Cells.Clear
    
19.         .[a1].Resize(n, UBound(arr, 2)) = brr
    
20.         .Activate
    
21.     End With
    
22. End Sub
    

复制代码

一休和尚

grf1973 发表于 2017-7-8 21:02
格式自调。

大师：
你这个代码可以改列数，比较方便；
我运行了一下，用条件格式检查重复值，再检查运行的结果后发现还有漏网之鱼；
有几个图号没有被合并，不知道问题在哪里

投诉	后盖	2646508	油漆残留	NC 405427	加工面和凹槽有油漆颗粒
投诉	P100注射底盖	5687377	打磨伤	NC 405699	P100底盖加工面凹坑
反馈	F3非标传动箱	02XF35018601L	标签错误	无	F3非标传动箱误发
投诉	P100注射底盖	5687377	粗糙度超差	nc 405699	5687377 加工面粗糙度超差     孔壁粗糙度超差     加工面有油漆残留     相交孔毛刺问题

grf1973

第6句改成  x = CStr(Trim(arr(i, 7)))   即可
可能是由于里面有不可见字符等原因。