如何将新旧产品（因产品更换名称改变）数据合计到一起

萧子逸飞

文件表2中有部分品种合并在一起了，原来的宏只能够带入单品种数据，无法将多出品种数量合计进行导入；
目的：在导入表1数据时，同时将表2中的多品种进行合计；

microyip

用字典，无论新旧，都对应出新品种，那么就可以合并咯

萧子逸飞

microyip 发表于 2018-7-9 15:21
用字典，无论新旧，都对应出新品种，那么就可以合并咯

现在的问题是源数据表中的品种是全部分开的，现在需要的是将输出表中的新旧品种在读入的同时进行合计，就是原数据中的新旧品种在输出表在同一列显示合计数量。求详细解答

萧子逸飞

microyip 发表于 2018-7-9 15:21
用字典，无论新旧，都对应出新品种，那么就可以合并咯

您好，问一下无论新旧都对应新品种的话，输出的结果是新旧品种合计数量吗？

萧子逸飞

microyip 发表于 2018-7-9 15:21
用字典，无论新旧，都对应出新品种，那么就可以合并咯

Sub 导入进销存数据()
    Dim m%, n%, o%, p%, a$, b$, rng1 As Range, rng2 As Range, c%
m = 8
c = ThisWorkbook.Worksheets(1).UsedRange.Columns.Count - 2
Do While ThisWorkbook.Worksheets(1).Cells(m, 2) <> ""
    On Error Resume Next
    a = Cells(m, 2).Value '将校验表里的经销商名称赋值给a
    Set rng1 = Workbooks(2).Worksheets(1).Columns(3).Find(a, , , , , xlNext) '从进销存中查找a
    n = rng1.Row '将进销存中查找到的a的行号赋值给n
        Do
        b = Workbooks(2).Worksheets(1).Cells(n, 5).Value '将品种名称赋值给b
        Set rng2 = ThisWorkbook.Worksheets(1).Rows(6).Find(b, , , , , xlNext) '在校验表根据品种名称查找单元格
        If Not rng2 Is Nothing Then
        p = rng2.Column '将查找到的单元格的列号赋值给p
        Workbooks(1).Worksheets(1).Cells(m, p + 1) = Workbooks(1).Worksheets(1).Cells(m, p + 1) + Workbooks(2).Worksheets(1).Cells(n, 6)
        Workbooks(1).Worksheets(1).Cells(m, p + c / 3 + 1) = Workbooks(1).Worksheets(1).Cells(m, p + c / 3 + 1) + Workbooks(2).Worksheets(1).Cells(n, 8).Value + Workbooks(2).Worksheets(1).Cells(n, 9).Value
        Workbooks(1).Worksheets(1).Cells(m, p + c / 3 * 2 + 1) = Workbooks(1).Worksheets(1).Cells(m, p + c / 3 * 2 + 1) + Workbooks(2).Worksheets(1).Cells(n, 16).Value
        End If
        n = n + 1
        Loop While Workbooks(2).Worksheets(1).Cells(n, 3) = Workbooks(2).Worksheets(1).Cells(n - 1, 3)
    m = m + 1
Loop
End Sub
您能帮忙看一下这个怎么修改么？

萧子逸飞

microyip 发表于 2018-7-9 15:21
用字典，无论新旧，都对应出新品种，那么就可以合并咯

Sub 导入进销存数据()
    Dim m%, n%, o%, p%, a$, b$, rng1 As Range, rng2 As Range, c%
m = 8
c = ThisWorkbook.Worksheets(1).UsedRange.Columns.Count - 2
Do While ThisWorkbook.Worksheets(1).Cells(m, 2) <> ""
    On Error Resume Next
    a = Cells(m, 2).Value '将校验表里的经销商名称赋值给a
    Set rng1 = Workbooks(2).Worksheets(1).Columns(3).Find(a, , , , , xlNext) '从进销存中查找a
    n = rng1.Row '将进销存中查找到的a的行号赋值给n
        Do
        b = Workbooks(2).Worksheets(1).Cells(n, 5).Value '将品种名称赋值给b
        Set rng2 = ThisWorkbook.Worksheets(1).Rows(6).Find(b, , , , , xlNext) '在校验表根据品种名称查找单元格
        If Not rng2 Is Nothing Then
        p = rng2.Column '将查找到的单元格的列号赋值给p
        Workbooks(1).Worksheets(1).Cells(m, p + 1) = Workbooks(1).Worksheets(1).Cells(m, p + 1) + Workbooks(2).Worksheets(1).Cells(n, 6)
        Workbooks(1).Worksheets(1).Cells(m, p + c / 3 + 1) = Workbooks(1).Worksheets(1).Cells(m, p + c / 3 + 1) + Workbooks(2).Worksheets(1).Cells(n, 8).Value + Workbooks(2).Worksheets(1).Cells(n, 9).Value
        Workbooks(1).Worksheets(1).Cells(m, p + c / 3 * 2 + 1) = Workbooks(1).Worksheets(1).Cells(m, p + c / 3 * 2 + 1) + Workbooks(2).Worksheets(1).Cells(n, 16).Value
        End If
        n = n + 1
        Loop While Workbooks(2).Worksheets(1).Cells(n, 3) = Workbooks(2).Worksheets(1).Cells(n - 1, 3)
    m = m + 1
Loop
End Sub
您好，请问您能帮忙看一下这个怎么修改吗?

萧子逸飞

microyip 发表于 2018-7-9 15:21
用字典，无论新旧，都对应出新品种，那么就可以合并咯

Sub 导入进销存数据()
    Dim m%, n%, o%, p%, a$, b$, rng1 As Range, rng2 As Range, c%
m = 8
c = ThisWorkbook.Worksheets(1).UsedRange.Columns.Count - 2
Do While ThisWorkbook.Worksheets(1).Cells(m, 2) <> ""
    On Error Resume Next
    a = Cells(m, 2).Value '将校验表里的经销商名称赋值给a
    Set rng1 = Workbooks(2).Worksheets(1).Columns(3).Find(a, , , , , xlNext) '从进销存中查找a
    n = rng1.Row '将进销存中查找到的a的行号赋值给n
        Do
        b = Workbooks(2).Worksheets(1).Cells(n, 5).Value '将品种名称赋值给b
        Set rng2 = ThisWorkbook.Worksheets(1).Rows(6).Find(b, , , , , xlNext) '在校验表根据品种名称查找单元格
        If Not rng2 Is Nothing Then
        p = rng2.Column '将查找到的单元格的列号赋值给p
        Workbooks(1).Worksheets(1).Cells(m, p + 1) = Workbooks(1).Worksheets(1).Cells(m, p + 1) + Workbooks(2).Worksheets(1).Cells(n, 6)
        Workbooks(1).Worksheets(1).Cells(m, p + c / 3 + 1) = Workbooks(1).Worksheets(1).Cells(m, p + c / 3 + 1) + Workbooks(2).Worksheets(1).Cells(n, 8).Value + Workbooks(2).Worksheets(1).Cells(n, 9).Value
        Workbooks(1).Worksheets(1).Cells(m, p + c / 3 * 2 + 1) = Workbooks(1).Worksheets(1).Cells(m, p + c / 3 * 2 + 1) + Workbooks(2).Worksheets(1).Cells(n, 16).Value
        End If
        n = n + 1
        Loop While Workbooks(2).Worksheets(1).Cells(n, 3) = Workbooks(2).Worksheets(1).Cells(n - 1, 3)
    m = m + 1
Loop
End Sub
怎么修改呢？

萧子逸飞

microyip 发表于 2018-7-9 15:21
用字典，无论新旧，都对应出新品种，那么就可以合并咯

您能帮我看一下哪里需要修改吗？不胜感激