Excel 搜索唯一编号并将其特定数据复制到另一张图纸

Excel 搜索唯一编号并将其特定数据复制到另一张图纸,excel,vba,Excel,Vba,我有一本有三张纸的工作簿 在第二张名为Grade Wise的纸上,我有原始数据 在名为Sheet1的第三张图纸上,我需要一个按钮,用于将数据从第二张图纸复制到第三张图纸 在第2页,A列和B列重复数据。这些农民提供了不同等级、不同权重的产品 我想将每个农民的唯一农民编号以及A列和B列数据的名称复制到第三页,如附图所示 在第二页中,C列有不同的等级,其起始字母为X、C、M、B,其第三个字母也包括A、F、C 挑战1:我想复制第3页第D列的所有X到X的总和,第3页第E列的所有C到C的总和,第3页第F列的

我有一本有三张纸的工作簿

在第二张名为Grade Wise的纸上,我有原始数据

在名为Sheet1的第三张图纸上,我需要一个按钮,用于将数据从第二张图纸复制到第三张图纸

在第2页,A列和B列重复数据。这些农民提供了不同等级、不同权重的产品

我想将每个农民的唯一农民编号以及A列和B列数据的名称复制到第三页,如附图所示

在第二页中,C列有不同的等级,其起始字母为X、C、M、B,其第三个字母也包括A、F、C

挑战1:我想复制第3页第D列的所有X到X的总和,第3页第E列的所有C到C的总和,第3页第F列的所有M到M的总和,以及第3页第G列的所有B到B的总和,如附图所示

VBA代码是为这个挑战编写的,正在运行,但我想添加以下操作

挑战2:还应查找第三个字母A、F、C,并在第三页第N列上复制其全部A到A的总和,在第三页第O列上复制全部F到F的总和,在第三页第p列上复制全部C到C的总和,如附图所示

挑战1代码是:

Sub test2()
Dim c As Object ' Dictionary
Dim Ws As Worksheet
Dim toWs As Worksheet
Dim vDB, vNum(), vR()
Dim k As Long, i As Long
Dim x As Long, y As Long
Dim s As String

Set Ws = Sheets(2)
Set toWs = Sheets(3)

Set c = CreateObject("Scripting.Dictionary")

vDB = Ws.Range("a1").CurrentRegion

For i = 2 To UBound(vDB, 1)
    If Not c.Exists(vDB(i, 1)) Then 'Farmer NO.
        k = k + 1
        c.Add vDB(i, 1), k 'Farmer NO.
        ReDim Preserve vNum(1 To 3, 1 To k)
        vNum(1, k) = k
        vNum(2, k) = vDB(i, 1)
        vNum(3, k) = vDB(i, 2)
    End If
Next i
ReDim vR(1 To k, 1 To 10)
For i = 2 To UBound(vDB, 1)
    s = Left(vDB(i, 3), 1)
    y = c.Item(vDB(i, 1)) 'Farmer no
    x = getIndex(s)
    vR(y, x) = vR(y, x) + vDB(i, 4) 'Bales
    vR(y, 5) = vR(y, 5) + vDB(i, 4) 'Sum of Bales
    vR(y, x + 5) = vR(y, x + 5) + vDB(i, 5) 'New Weight
    vR(y, 10) = vR(y, 10) + vDB(i, 5) 'Sum of Weight
Next i

With toWs
    .UsedRange.Offset(2).Clear
    .Range("a3").Resize(k, 3) = WorksheetFunction.Transpose(vNum)
    .Range("d3").Resize(k, 10) = vR
    .UsedRange.Borders.LineStyle = xlContinuous
End With
End Sub


Function getIndex(v As String)
    Dim i As Integer
    Select Case v
    Case "X"
        i = 1
    Case "C"
        i = 2
    Case "M"
        i = 3
    Case "B"
        i = 4
    End Select
    getIndex = i
End Function
样本数据图片

填充前两列Farmer No后,一个简单的公式就足够了。使用高级过滤器从数据中选择唯一的值,使用Vlookup选择Farmer Name。然后你只需要一个公式,比如=SUMIFS$C$2:$C$18,$A$2:$A$18,$E2,$B$2:$B$18,F$1&*然后你可以把它复制下来

参见图


如果您担心为新客户的新条目自动执行此操作,只需在包含FarmerNo的同一工作簿中维护主工作表即可。还有名字。在输入数据之前,您只需检查农民是否在主数据中。这可以通过简单的重复名称条件格式实现。如果您这样做,您甚至可以删除数据中的“姓名”列或Sheet3中的“农民编号”列

您自己尝试了什么代码?我想要Excel中的VBA代码,但我们不是免费编写代码的服务。。。我们帮助您解决您尝试的代码,并在此过程中学习一些东西…亲爱的,我是excel中VBA的新手,我还没有尝试过任何代码。我已手动将数据复制到第三页。我想通过单击一个按钮来自动化这个过程。请帮助我@Dy.Lee我需要你的帮助请我非常感谢你的回答,我会试试。我们可以通过VBA来完成吗。我只需要一个按钮,点击它就可以完成你建议的工作,你可以用VBA来完成,但是。。如果无法使用简单公式和简单excel工具,我建议使用VBA。优点是简单。您可以随时编辑此内容。但是不擅长VBA的人会再次发现编辑代码很困难。。我希望你能尽快找到解决办法。好的,我知道了。。你需要一个按钮来实现全自动化。。您将如何填写数据表?。。您必须手动完成吗?然后我想,点击一个按钮并复制第3页中的一行公式几乎需要相同的时间?嗯……你是对的……我正在尝试,但它不起作用……我正在应用具有唯一值的高级过滤器,但它也在复制重复值。你能分享一下你的邮件吗?我会把表格寄给你的。当做