走过路过的大神，烦请你们留步，帮我这个菜鸟看看

chenzhaozhen

拜托各位大神了
工作表“原始单”里的数据不能变，工作表“统计”里的ABC三栏是复制“原始单”BCD这三栏数据的，但是没有重复的（"原始单“BCD这三栏的数据删除了重复值后放到了”统计“ABC三栏里）。”统计“表里的D（数量）这栏是”原始单“里的数据统计过来，”统计“表里的E（单价）这栏是从另外一个文件”工价表“里引过来的，请问各位大神，怎么做？

dequang

把工价表也放在同一个工作簿了，顺便也帮你计算金额了，工作表里有6000多行数据，要运行5秒左右你看下在4月统计表里有部分产品在工价表里是找不到的，所以没统计数量和金额

4月计件.rar (227.67 KB, 下载次数: 2)

2019-2-15 10:14 上传

点击文件名下载附件

chenzhaozhen

dequang 发表于 2019-2-15 10:15
把工价表也放在同一个工作簿了，顺便也帮你计算金额了，工作表里有6000多行数据，要运行5秒左右你看下在4月 ...

大神，真是太感谢你了，你实在太厉害了，佩服的五体投地啊

dequang

chenzhaozhen 发表于 2019-2-15 14:09
大神，真是太感谢你了，你实在太厉害了，佩服的五体投地啊

在相应位置插入红色框的Exit For运行速度还能提升1秒左右
我不是什么大神，不要看轻你自己，不够一个月前我和你差不多，只要你想学，网上谁都可以是你的老师

chenzhaozhen

dequang 发表于 2019-2-15 14:34
在相应位置插入红色框的Exit For运行速度还能提升1秒左右
我不是什么大神，不要看轻你自己，不够一 ...

嗯嗯嗯，因为听别人说起过，说VBA好用，所以过年后一直在看这方面的视频，但是一知半解的。今天一下午都在研究你给我的这份表，本来想试试能不能把1年12个月的都放进去，结果前面的数量统计倒是出来了。后面的单价却不能出来，我试过了很多次，还是不行。我还有一个问题想问你，如果我把这个工价表不放这张表里，是另个的一个文件的话，该怎么弄呢？因为工价表每个月都会有一些新的增加进去的

dequang

chenzhaozhen 发表于 2019-2-15 16:45
嗯嗯嗯，因为听别人说起过，说VBA好用，所以过年后一直在看这方面的视频，但是一知半解的。今天一下午 ...

不是每个月统计一次吗，你想一年算一次呀
每月清空下相应工作表里的数据（保留4月原始单里的表头），再加入某个月就行了，红色框的工作表不要改名，数据相应列也要放对就行了，
单价出不来了可能是工作表里的产品名和4月原始单里的不一样

chenzhaozhen

dequang 发表于 2019-2-15 17:26
不是每个月统计一次吗，你想一年算一次呀
每月清空下相应工作表里的数据（保留4月原始单里的表头）， ...

不是一年算一次啦，是我想差了，原来前面也会重算的，我正在复制了一个文件，里面的工作表名会自动变化的，不怕了

dequang

chenzhaozhen 发表于 2019-2-15 18:11
不是一年算一次啦，是我想差了，原来前面也会重算的，我正在复制了一个文件，里面的工作表名会自动变化 ...

服务器又上传不了图片了
相应在地方改成它，运行速度更快。


Sub 录入单价及金额()
    '字典、数组结合
    On Error Resume Next
    Sheets("4月统计").Range("e2:f" & Range("a" & Rows.Count).End(xlUp).Row).ClearContents
    Set d = CreateObject("scripting.dictionary")
    Dim arr, brr
    With Sheets("工价表")
        arr = .Range("a1:c" & .Range("a" & Rows.Count).End(xlUp).Row)
    End With
    With Sheets("4月统计")
        brr = .Range("b2:f" & .Range("b" & Rows.Count).End(xlUp).Row)
    End With

    For i = 2 To UBound(arr)
        '关键字最后一次出现所在的行，可随时在工价表最后一行添加数据，不管前面的产品规格有没有出现过，单价以最后一次为准
        d(arr(i, 1) & arr(i, 2)) = i

        '关键字第一次出现所在的行，按需选择
        'd.Add arr(i, 1) & arr(i, 2), i
    Next
    For i = 1 To UBound(brr)
        If d(brr(i, 1) & brr(i, 2)) = False Then
            brr(i, 4) = "在工价表里找不到该型号，请检查"
        Else
            k = d(brr(i, 1) & brr(i, 2))
            brr(i, 4) = arr(k, 3)
            brr(i, 5) = brr(i, 3) * brr(i, 4)
        End If
    Next

    [e2].Resize(UBound(brr), 1) = WorksheetFunction.Index(brr, 0, 4)
    [f2].Resize(UBound(brr), 1) = WorksheetFunction.Index(brr, 0, 5)
    Set d = Nothing
End Sub

dequang 发表于 2019-2-15 14:34
在相应位置插入红色框的Exit For运行速度还能提升1秒左右
我不是什么大神，不要看轻你自己，不够一 ...

大神，方便留个QQ吗？有问题想单独沟通。

dequang

奔跑的蜗牛 发表于 2019-2-25 10:11
大神，方便留个QQ吗？有问题想单独沟通。

不是什么大神，不是专业弄这个的，平时忙啊，QQ基本没用，有问题也可以在论坛上问的