简单的复制 插入 粘贴问题 ，希望能用vba解决

1e3e

zopey 发表于 2018-3-26 08:43
问题1、代码执行后，没有复制“某县某镇某村渠道防渗工程”的49万元！！！
     空表 32标号附近的单元格 ...

请再看看，非常感谢你宝贵的帮助

zopey

1e3e 发表于 2018-3-26 20:38
请看附件，
1、如果我将“”样表一“再复制一份改名为"样表二",（就是将样表一 和样表二的 数据汇总 至 ...

样表1 字典dica本来有57+1项,精确对应每个小项，
样表2 随意删除某些行后 .字典dica 就只剩下21项，变的不完备了

原来适用的逻辑 现在错误 是很自然的，空表 48 开始乱来了。

1e3e

怎么修改呢？因为有些人交给我的表就是要删除没有投资额的部分

zopey

1e3e 发表于 2018-3-27 09:26
怎么修改呢？因为有些人交给我的表就是要删除没有投资额的部分

遇到断行的问题,哪些行需要复制呢？
要由你来规定一套办法 ,就像一楼那样的方案！才能修改代码来实现它

1e3e

zopey 发表于 2018-3-27 09:44
遇到断行的问题,哪些行需要复制呢？
要由你来规定一套办法 ,就像一楼那样的方案！才能修改代码来实现它

向大侠致歉，本人手抖在单元格x39中误打了一个58，我已经把58删除了。

思路对于大侠而言很简单，举个例子对于样表二就是：
1、x列中数字一定是从小到大排列。

2、在x列中寻找最小值，对于样表二就是28，获取28的行号4，接下来再寻找除去28外的最小值，即29，获取29的行号6，
复制的起始行是4+1，复制的终结行是6-1，所以要复制的部分为：起始行第5行，终结行第5行。
   下面，获取x列中除28、29外的最小值30,(已经寻找过的x列数值全部排除之！！！！因为28和29已经寻找过，就排除在外）
如果28的行号为4, 29行号为5,即复制范围为起始行4+1行，终结行5-1行，即相邻则无须复制。


依次类推往下寻找：当寻找至38时，此时38是第17行到表格最末行的最小值，获取38的行号17，接下来再寻找除去已经寻找过的x列数值的最小值为49，获取49行号为23，复制的起始行是17+1，复制的终结行为49-1,所以要复制的部分为：起始行第18行，终结行第48行。


如果x列中全部数字恰好取完，则执行如上操作即可。
如果x列中只取剩一个数字，这个数字在样表二中恰好为57，（在其它样表中可能不是57，因为当"七、其他费用b计划"没有投资额时，也有可能会被删除，所以这最后一个数可能为55、53、32…等任一个。）,这时获取57的行号为34，复制起始行第34行，复制终结行为34+15行，因为明细项不会超过15行。

1e3e

zopey 发表于 2018-3-27 09:44
遇到断行的问题,哪些行需要复制呢？
要由你来规定一套办法 ,就像一楼那样的方案！才能修改代码来实现它

烦劳您再看看了

zopey

1e3e 发表于 2018-3-27 11:02
向大侠致歉，本人手抖在单元格x39中误打了一个58，我已经把58删除了。

思路对于大侠而言很简单，举个 ...

Set dica = CreateObject("Scripting.Dictionary")
With Worksheets("样表二")
For i = 2 To 99
    If .Cells(i, 24).Value > 0 Then
       dica(.Cells(i, 24).Value) = i
       dica(k + 1) = i
       k = .Cells(i, 24).Value
    Else
    End If
Next
End With


鉴于有删除行，修改了上面一段，试试看
( “58” 是我加入的结束标志。)
运行错误2.zip (105.14 KB, 下载次数: 11)

2018-3-27 14:05 上传

点击文件名下载附件

zopey

按照楼主提供的思路来写代码，你理解起来就更容易，
用起来就更方便。（可以自己动手改改）

1e3e

zopey 发表于 2018-3-27 14:09
Set dica = CreateObject("Scripting.Dictionary")
With Worksheets("样表二")
For i = 2 To 99

大侠，我今天又实践了一下，发现最后的明细项无法复制，请看附件点“运行我”，最后有6万元无法复制粘贴！！！！！！！！！！！！！！！！！！

1e3e

zopey 发表于 2018-3-27 14:12
按照楼主提供的思路来写代码，你理解起来就更容易，
用起来就更方便。（可以自己动手改改）

请您费心再看看啊