在线求助一个函数，特急特急！没法好好过端午了！

skp669

总表样式及分表样式见上面附件

skp669

试了一下，很好用！谢谢
另外想问 一下，我的这1000多个表单里面，引用了类似于总表的这个工作表有8个，想问一下，怎么来修改这个VBA？
也就是说1-100引用了总表1，101-200引用了总表2.....

大谢！
8个总表名称分别改为10000,20000……80000，代码如下
Sub test()
    Dim k1%, k2%, k3%, k4%, k5%, k6%, k7%, k8%, j$
    For Each sht In Worksheets
        j = sht.Name
        i = j + 0
        Select Case i
        Case Is < 101
            sht.Cells(2, 2) = Worksheets("10000").Cells(k1 + 1, 4)
            k1 = k1 + 1
        Case Is < 201
            sht.Cells(2, 2) = Worksheets("20000").Cells(k2 + 1, 4)
            k2 = k2 + 1
        Case Is < 301
            sht.Cells(2, 2) = Worksheets("30000").Cells(k3 + 1, 4)
            k3 = k3 + 1
        Case Is < 401
            sht.Cells(2, 2) = Worksheets("40000").Cells(k4 + 1, 4)
            k4 = k4 + 1
        Case Is < 501
            sht.Cells(2, 2) = Worksheets("50000").Cells(k4 + 1, 4)
            k5 = k5 + 1
        Case Is < 601
            sht.Cells(2, 2) = Worksheets("60000").Cells(k3 + 1, 4)
            k6 = k6 + 1
        Case Is < 701
            sht.Cells(2, 2) = Worksheets("70000").Cells(k4 + 1, 4)
            k7 = k7 + 1
        Case Is < 801
            sht.Cells(2, 2) = Worksheets("80000").Cells(k4 + 1, 4)
            k8 = k8 + 1
        End Select
    Next
End Sub

skp669

更正一下
Sub test()
    Dim k1%, k2%, k3%, k4%, k5%, k6%, k7%, k8%, j$
    For Each sht In Worksheets
        j = sht.Name
        i = j + 0
        Select Case i
        Case Is < 101
            sht.Cells(2, 2) = Worksheets("10000").Cells(k1 + 1, 4)
            k1 = k1 + 1
        Case Is < 201
            sht.Cells(2, 2) = Worksheets("20000").Cells(k2 + 1, 4)
            k2 = k2 + 1
        Case Is < 301
            sht.Cells(2, 2) = Worksheets("30000").Cells(k3 + 1, 4)
            k3 = k3 + 1
        Case Is < 401
            sht.Cells(2, 2) = Worksheets("40000").Cells(k4 + 1, 4)
            k4 = k4 + 1
        Case Is < 501
            sht.Cells(2, 2) = Worksheets("50000").Cells(k5 + 1, 4)
            k5 = k5 + 1
        Case Is < 601
            sht.Cells(2, 2) = Worksheets("60000").Cells(k6 + 1, 4)
            k6 = k6 + 1
        Case Is < 701
            sht.Cells(2, 2) = Worksheets("70000").Cells(k7 + 1, 4)
            k7 = k7 + 1
        Case Is < 801
            sht.Cells(2, 2) = Worksheets("80000").Cells(k8 + 1, 4)
            k8 = k8 + 1
        End Select
    Next
End Sub

HYUN2000

skp669 发表于 2016-6-10 00:33
更正一下
Sub test()
    Dim k1%, k2%, k3%, k4%, k5%, k6%, k7%, k8%, j$

谢谢您！
看你的示例是成功好用的！可是我太笨了，琢磨了半天想修改一点点单元格位置却没弄出来，再次麻烦您一下了，下面我上一个附件，是按我的格式来的，公式麻烦您再帮我调整一下下，再次谢谢了！

HYUN2000

谢谢！我微调了一下，现在表单格子都对上了！
公式里面有个：i=j + 0
       我也不懂是什么意思，调试时显示是错了，我改成i=j ，就OK了！
总之，是完美解决了，谢谢！！！

HYUN2000

skp669 发表于 2016-6-10 00:33
更正一下
Sub test()
    Dim k1%, k2%, k3%, k4%, k5%, k6%, k7%, k8%, j$

发现了一个新问题
利用这个公式，想要的都实现了，单元格与对应单元格的对应关系也都对了，现在有一个问题就是：
      被引用的单元格里的内容变了之后，引用的单元格内容却是不变的。
能不能完善一下这一功能，就是前面的方案变了，后面的对应着也能变，谢谢！再次辛苦你！

skp669

如果被引用的单元格内容变了，你可以再次运行代码