多列日期转换成单列日期问题

xiang当当

最近接手一些新工作，但旧的记录不规范、不利于统计分析，想梳理成规范的记录。今年9个月的数据如果靠人工处理就耗时太久、也机易出错，所以拜请各位老师提供个合适代码，在此先行谢过各位～

转换要求：主要是把多列日期转换成单列日期，且其余数据对应。转换后，删除生产数量为0的行数据，删除不合格数量为0的行数据。因为旧表本身不规范，可以先做简单的规范化处理再使用VBA，也可以使用辅助列。

蓝桥玄霜

转换的代码：

xuemei0216

看一下，是不是你想要的

xiang当当

xuemei0216 发表于 2019-10-12 10:28
看一下，是不是你想要的

怎么没看到有公式/代码？

xuemei0216

xiang当当 发表于 2019-10-12 11:05
怎么没看到有公式/代码？

哦，传错了。把你原附件传上来了。这个应该有了

xiang当当

蓝桥玄霜 发表于 2019-10-12 10:28
转换的代码：

老师好，VBA整理之后，不合格数量之和是297；在旧表E列筛选“数量”后，F列求和是252；两者的不合格数量对应不上这是什么问题？
另外，麻烦老师帮忙修改下，数据重排后，只删除生产数量为0的行数据，不删除不合格数量为0的行数据（核对才发现删除不合格数量为0的行数据会把部分生产数量不为0的也删除了，影响生产数量的准确性）。
谢谢老师～

xiang当当

xuemei0216 发表于 2019-10-12 11:08
哦，传错了。把你原附件传上来了。这个应该有了

老师好，VBA整理之后，不合格数量之和是297；在旧表E列筛选“数量”后，F列求和是252；两者的不合格数量对应不上这是什么问题？
另外，麻烦老师帮忙修改下，数据重排后，只删除生产数量为0的行数据，不删除不合格数量为0的行数据（核对才发现删除不合格数量为0的行数据会把部分生产数量不为0的也删除了，影响生产数量的准确性）。
谢谢老师～

lsdongjh

1. Option Explicit
   
2. 
   
3. Sub Test()
   
4.     Dim shData As Worksheet, shResult As Worksheet
   
5.     Dim lngMax As Long, arrData As Variant, arrDateTitle As Variant
   
6.     Dim lngCur As Long, arrResult As Variant
   
7.     Dim rgType  As Range, lngRows As Long
   
8.     Dim lngRowID As Long, lngColID As Long
   
9.     Dim strType As String, strID As String, strMemo As String
   
10.     Dim lngProNum As Long, strUnCause As String
    
11.     Dim lngNum As Long, strDate As String, lngCountNum As Long
    
12.    
    
13.     Set shData = Sheets("旧表数据")
    
14.     Set shResult = Sheets("新表")
    
15.     arrDateTitle = shData.Range("G2").Resize(1, 31)
    
16.    
    
17.     lngMax = shData.Range("E" & Rows.Count).End(xlUp).Row
    
18.     ReDim arrResult(1 To lngMax * 31, 1 To 7)
    
19.     lngCur = 0
    
20.    
    
21.     Set rgType = shData.Range("A3")
    
22.     Do Until rgType.Row > lngMax
    
23.         If rgType.MergeCells Then Set rgType = rgType.MergeArea
    
24.         lngRows = rgType.Rows.Count
    
25.         
    
26.         If lngRows > 3 Then
    
27.             strType = rgType(1).Value '物料种类
    
28.             strID = rgType.Offset(0, 1)(1).Value '物料编码
    
29.             strMemo = rgType.Offset(0, 2)(1).Value '物料描述
    
30. 
    
31.             
    
32.             arrData = rgType.Offset(0, 4).Resize(lngRows, 33)
    
33.             
    
34.             For lngColID = 3 To 31
    
35.                 strDate = arrDateTitle(1, lngColID) '日期
    
36.                 lngProNum = Val(arrData(2, lngColID)) '生产数量
    
37.                 lngCountNum = Val(arrData(3, lngColID)) '不合格数量
    
38.                 If lngProNum > 0 Then '如果生产数量>0
    
39.                     If lngCountNum > 0 Then '如果不合格总数量>0
    
40.                         For lngRowID = 4 To lngRows
    
41.                             strUnCause = arrData(lngRowID, 1) '不合格原因
    
42.                             lngNum = arrData(lngRowID, lngColID) '不合格数量
    
43.                             If lngNum > 0 Then '如果具体不合格项的数量>0
    
44.                                 lngCur = lngCur + 1
    
45.                                 arrResult(lngCur, 1) = strType
    
46.                                 arrResult(lngCur, 2) = strID
    
47.                                 arrResult(lngCur, 3) = strMemo
    
48.                                 arrResult(lngCur, 4) = lngProNum
    
49.                                 arrResult(lngCur, 5) = strUnCause
    
50.                                 arrResult(lngCur, 6) = lngNum
    
51.                                 arrResult(lngCur, 7) = strDate
    
52.                             End If
    
53.                         Next
    
54.                     Else '如果没有不合格，增加一条生产数量的记录
    
55.                         lngCur = lngCur + 1
    
56.                         arrResult(lngCur, 1) = strType
    
57.                         arrResult(lngCur, 2) = strID
    
58.                         arrResult(lngCur, 3) = strMemo
    
59.                         arrResult(lngCur, 4) = lngProNum
    
60.                         arrResult(lngCur, 7) = strDate
    
61.                     End If
    
62.                 End If
    
63.             Next
    
64.         End If
    
65.         
    
66.         Set rgType = rgType.Offset(1, 0)
    
67.     Loop
    
68.    
    
69.     shResult.Range("A2:G" & Rows.Count - 1).ClearContents
    
70.     shResult.Range("A2").Resize(lngCur, 7) = arrResult
    
71.    
    
72.     MsgBox "OK"
    
73. End Sub
    

复制代码

xiang当当

lsdongjh 发表于 2019-10-12 16:40

你好，代码达到的效果是我需要的，不过数据不对应了，如附件，挑选了旧表28号的数据作对比，生产数量和不合格数量对应不上。
另外总的生产数量去重后是149713，总的不合格数量是297。
补充：旧表中，“合计”所在的列与“数量”所在的行，是包含求和公式的；但我核对了好几次，才发现这些公式中有部分单元格没有填充到（例如旧表AH205），所以这两行数据是不准确的，不能直接使用。