根据客户料号排序后合并，对相同的的料号的裁切总数以及原材不良品数进行求和

chengjinghu

根据客户料号排序后把相同料号合并，对相同的的料号的裁切总数以及原材不良品数进行分别求和（求和位置在数据区域后两列）。
求助！！！！

y1983y

折衷一下，应该是你要的结果。

chengjinghu

y1983y 发表于 2020-1-14 16:04
折衷一下，应该是你要的结果。

非常感谢
现在发现一个问题 我膜片sheet执行后，发现部分title未完全显示

SqlStr = "Select 客户料号,"""","""","""",sum(裁切总数),sum(原材不良品数) " & _
            "from [膜片$a1:f65536] where 客户料号 is not null group by 客户料号"

客户料号                       机种名        品名        材质        裁切总数(PCS)-求和        原材不良品数（pcs)-求和
133FH715212B                                                                    20239        80
140FH516111B                                                                   12650        222
140WHM16141B                                                                   15875        84
140WHM16261B                                                                   4080        0

麻烦帮忙看一下  谢谢

y1983y

chengjinghu 发表于 2020-1-14 16:31
非常感谢
现在发现一个问题 我膜片sheet执行后，发现部分title未完全显示

我这里一切正常啊！在sheet1工作表里，这部分代码你引用了没？iRow = .Range("a65536").End(xlUp).Row
        iCol = .Cells(1, Columns.Count).End(xlToLeft).Column
        .Range("a2").Resize(iRow, iCol).Borders.LineStyle = True
        Set d = CreateObject("scripting.dictionary")
        jRow = Sheet2.Range("a65536").End(xlUp).Row
        jCol = Sheet2.Cells(1, Columns.Count).End(xlToLeft).Column
        brr = Sheet2.Range("a1").Resize(jRow, jCol)
        arr = .Range("a1").Resize(iRow, iCol)
        For j = 2 To UBound(brr)
            d(brr(j, 1) & "") = j
        Next
        For i = 2 To UBound(arr)
            If d.exists(arr(i, 1) & "") Then
                m = d(arr(i, 1) & "")
                For n = 2 To 4
                    arr(i, n) = brr(m, n)
                Next
            End If
        Next
        .[a1].Resize(UBound(arr), UBound(arr, 2)) = arr

chengjinghu

y1983y 发表于 2020-1-15 07:35
我这里一切正常啊！在sheet1工作表里，这部分代码你引用了没？iRow = .Range("a65536").End(xlUp).Row
  ...

怎么说呢  我是在你代码基础上直接改的 取【膜片】的数据
Option Explicit

Sub DataList()
    Application.ScreenUpdating = False
    Application.Calculation = xlManual
    Dim cnn As Object, SqlStr As String
    Dim iRow As Long, iCol As Long, jRow As Long, jCol As Long, i As Long, j, m, n As Long
    Dim d, arr, brr
    With Sheet3
        iRow = .Range("a65536").End(xlUp).Row
        If iRow > 2 Then
            .Range("a2:f" & iRow).Clear
        End If
        
        Set cnn = CreateObject("adodb.connection")
        #If VBA7 And Win64 Then
            cnn.Open "provider=microsoft.ACE.oledb.12.0;extended properties=excel 8.0;data source=" & ThisWorkbook.FullName
        #Else
            cnn.Open "provider=microsoft.jet.oledb.4.0;extended properties='excel 8.0;hdr=yes;imex=1';data source=" & ThisWorkbook.FullName
        #End If
        SqlStr = "Select 客户料号,"""","""","""",sum(裁切总数),sum(原材不良品数) " & _
            "from [膜片$a1:f65536] where 客户料号 is not null group by 客户料号"
        .[a2:h65536].ClearContents
        SqlStr = "select * from (" & SqlStr & ") where 客户料号 is not null order by 客户料号"
        .[a2].CopyFromRecordset cnn.Execute(SqlStr)
        Set cnn = Nothing
        iRow = .Range("a65536").End(xlUp).Row
        iCol = .Cells(1, Columns.Count).End(xlToLeft).Column
        .Range("a2").Resize(iRow, iCol).Borders.LineStyle = True
        Set d = CreateObject("scripting.dictionary")
        jRow = Sheet2.Range("a65536").End(xlUp).Row
        jCol = Sheet2.Cells(1, Columns.Count).End(xlToLeft).Column
        brr = Sheet2.Range("a1").Resize(jRow, jCol)
        arr = .Range("a1").Resize(iRow, iCol)
        For j = 2 To UBound(brr)
            d(brr(j, 1) & "") = j
        Next
        For i = 2 To UBound(arr)
            If d.exists(arr(i, 1) & "") Then
                m = d(arr(i, 1) & "")
                For n = 2 To 4
                    arr(i, n) = brr(m, n)
                Next
            End If
        Next
        .[a1].Resize(UBound(arr), UBound(arr, 2)) = arr
        MsgBox "更新成功!"
    End With
    Application.ScreenUpdating = True
    Application.Calculation = xlAutomatic
End Sub

如下：【机种名】、【品名】、【材质】的结果均未提取成功。
客户料号                               机种名        品名        材质        裁切总数(PCS)-求和        原材不良品数（pcs)-求和
133FH715212B                                                                              20239                                        80
140FH516111B                                                                              12650                                      222
140WHM16141B                                                                               15875                                 84
140WHM16261B                                                                                  4080                                 0

y1983y

chengjinghu 发表于 2020-1-15 09:44
怎么说呢  我是在你代码基础上直接改的 取【膜片】的数据
Option Explicit

更换工作表，下面的内容也要改变的。

chengjinghu

y1983y 发表于 2020-1-15 11:07
更换工作表，下面的内容也要改变的。

不好意思  有没有可能做一个下拉框 可以通过下拉框来选择需要执行的sheet数据，选择后 点击执行按钮，会导出执行后的数据。
谢谢

y1983y

chengjinghu 发表于 2020-1-15 13:10
不好意思  有没有可能做一个下拉框 可以通过下拉框来选择需要执行的sheet数据，选择后 点击执行按钮，会 ...

这个有点难度，必须保证所有工作表结构格式一致才能做下拉列表