悬赏人民币100元，求大神把一张表里的内数据导出到另一张表，有人做吗？

yochlee

悬赏人民币100元，求大神把一张表里的内数据导出到另一张表，有人做吗？

小花鹿

很多区域要复制，太麻烦了，100元不值得

yochlee

小花鹿 发表于 2017-6-23 09:58
很多区域要复制，太麻烦了，100元不值得

那要多少喔

小花鹿

yochlee 发表于 2017-6-23 10:32
那要多少喔

主要是还要增加删除行，判断起来很麻烦

yochlee

小花鹿 发表于 2017-6-23 10:40
主要是还要增加删除行，判断起来很麻烦

可以把表格分成几个段落最多5个就可以了，执一差不多一样的代码，这样只是每个段落查找的关键字不一样。

yochlee

小花鹿 发表于 2017-6-23 10:40
主要是还要增加删除行，判断起来很麻烦

TEST1表头那几个格子容易处理与TEST0完全相同位置，接下来就是B列查找“部件名称”这个字段到B列为“整个产品”止（结果是第9行开始到20行），复制“部件名称”下面粉红色度有数据的行内到TEST0里B列查找“部件名称”这个字段到B列为“整个产品”止（结果是第13行开始到37行），增加不够的行，删除多余的行。第二段同上B列查找“五金名称”处理24到42行，第三段同上B列查找“部件”处理45到130行。这三段的代码应该可以差不多，只是稍作修改，不是道想法是不是这样。
按这想法我只能做成这样，不知道怎么弄下去了，都是套论坛里有的例子套的。

Sub 副本数据更新到正本()
'Ar = Array([c1].Value, [h1].Value, [j1].Value, [o1].Value, [t1].Value, [w1].Value, [r2].Value, [s2].Value, [t2].Value, [u2].Value, [v2].Value, [w2].Value)
    Dim wb As Workbook, sh As Worksheet, xrng As Range
    'sh为工作表，xing为对象
    Dim fname As String
    'fname 为可变字符串
    Sn = ActiveSheet.Name
    Wn = ActiveWorkbook.Name
    t = Time

    'fname=当前工作表名
    Dim f As Boolean
Dim w As Workbook
f = False
For Each w In Workbooks
    If w.Name = "产品核算.xlsm" Then   '查询是否开启的文件名
       f = True
       GoTo EEE
    End If
Next w
If f = False Then
Workbooks.Open "d:\2\产品核算.xlsm"
End If
EEE:
Workbooks(Wn).Sheets(Sn).Activate
'br = Array(c1, h1, j1, o1, t1, w1, r2, s2, t2, u2, v2, w2)
Workbooks("产品核算").Sheets(Sn).Activate
'For i = 0 To UBound(br)
Workbooks("产品核算").Sheets(Sn).Range("c1") = Workbooks(Wn).Sheets(Sn).Range("c1")
  Workbooks("产品核算").Sheets(Sn).Range("h1") = Workbooks(Wn).Sheets(Sn).Range("h1")
   Workbooks("产品核算").Sheets(Sn).Range("j1") = Workbooks(Wn).Sheets(Sn).Range("j1")
   Workbooks("产品核算").Sheets(Sn).Range("o1") = Workbooks(Wn).Sheets(Sn).Range("o1")
   Workbooks("产品核算").Sheets(Sn).Range("t1") = Workbooks(Wn).Sheets(Sn).Range("t1")
   Workbooks("产品核算").Sheets(Sn).Range("w1") = Workbooks(Wn).Sheets(Sn).Range("w1")
   Workbooks("产品核算").Sheets(Sn).Range("r3") = Workbooks(Wn).Sheets(Sn).Range("r3")
   Workbooks("产品核算").Sheets(Sn).Range("s3") = Workbooks(Wn).Sheets(Sn).Range("s3")
  Workbooks("产品核算").Sheets(Sn).Range("t3") = Workbooks(Wn).Sheets(Sn).Range("t3")
Workbooks("产品核算").Sheets(Sn).Range("u3") = Workbooks(Wn).Sheets(Sn).Range("u3")
Workbooks("产品核算").Sheets(Sn).Range("v3") = Workbooks(Wn).Sheets(Sn).Range("v3")
Workbooks("产品核算").Sheets(Sn).Range("w3") = Workbooks(Wn).Sheets(Sn).Range("w3")
'Next i
Dim arr(1 To 1000, 1 To 5)
    'arr为（行1到1000，列1到5）
cz = Array(2, 3, 4, 5, 6) '要倒腾到自动统计表中的列
    'cz = 数组(2, 3, 4, 5, 6)
            Set xrng = Workbooks(Wn).Sheets(Sn).[b:b].Find("部件名称", lookat:=xlWhole)
            '设置xrng=sh的A列查找（部件名称，全部匹配）
                brr = Workbooks(Wn).Sheets(Sn).Range(xrng, sh.Cells(r, "F"))   '要倒腾的数据源
                'brr=表对象（xrng,sh.单元格（r,"F"））
                For i = 2 To UBound(brr)
                'For循环i=2到数组brr的57列
                    If brr(i, 1) = "" Then brr(i, 1) = brr(i - 1, 1)
                    '假如倒腾的数据源(2，1)=空，那么倒腾的数据源(2.1)=倒腾的数据源(1.1)
                    If brr(i, 2) <> "" And brr(i, 2) <> "整个产品" Then
                    '假如倒腾的数据源(2，2)不等于空和倒腾的数据源(2,2)不等于 "整个产品" 那么
                        n = n + 1
                        'n=n+1
                         For k = 1 To 5
                        'For循环k=1到5
                            arr(n, k) = brr(i, cz(k - 1))
                            '统计表(n行,k列)=工段后(2,cz(k-3))
                        Next
                        '下一个For循环k
                    End If
                    '结束假如brr(i，2)不等于空和零件
                Next
                '下一个For循环i=2到“工段”的第57列
   Workbooks("产品核算").Sheets(Sn).[B9].Resize(n, 5) = arr
MsgBox Format(Time - t, "hh:mm:ss") '      r=最后一个非空行号           brr=“工段”到BE列最后一非空  i=2  n=n+1   k=3-35
'弹出消息框 格式（用时，“小时：分钟：秒”
End Sub
菜鸟没办法

yochlee

可以做的老师也可以开价喔

yochlee

200块有人做吗？

lmze2000

太烦琐复杂，还没太看明白是要实现什么.

小花鹿

yochlee 发表于 2017-6-24 14:53
200块有人做吗？

如果你要做，联系我，QQ：3395417758