[已解决]用VBA怎么实现这种简单的合并规律?

浪子神剑

用VBA怎么实现这种简单的合并规律?
样本在附件.

最佳答案

月排行榜 / 总排行榜

mn860429

2011-3-22 14:30

1. Sub cc()
   
2.     Dim arr()
   
3.     For i = 8 To 12    '数据的行数
   
4.         mylen = Len(Cells(i, 2))
   
5.         ReDim arr(1 To mylen)
   
6.         For k = 1 To mylen
   
7.             arr(k) = Val(Mid(Cells(i, 2), k))
   
8.         Next k
   
9.         myyear = Application.Max(arr)
   
10.         Cells(i, 6).Value = Left(Cells(i, 3), Len(Cells(i, 3)) - 4) & "-" & myyear & "-" & "<1," & Cells(i, 5) & ",1,False,False>.htm"
    
11.         Erase arr
    
12.     Next i
    
13. End Sub

复制代码

跳转到最佳答案楼层

豆丁

1. Sub test()
   
2. Dim arr, arrt(), i%, n$
   
3. arr = Range("b8:e" & [b65536].End(3).Row)
   
4. ReDim arrt(1 To UBound(arr), 1 To 1)
   
5. For i = 1 To UBound(arr)
   
6.     n = Mid(arr(i, 1), InStr(1, arr(i, 1), "年度") - 4, 4)
   
7.     arrt(i, 1) = Replace(arr(i, 2), ".htm", "-" & n & "-<1," & arr(i, 4) & ",1,False,False>.htm")
   
8. Next
   
9. Range("f:f").ClearContents
   
10. [f8].Resize(UBound(arrt), 1) = arrt
    
11. End Sub
    

复制代码

mn860429

1. Sub cc()
   
2.     Dim arr()
   
3.     For i = 8 To 12    '数据的行数
   
4.         mylen = Len(Cells(i, 2))
   
5.         ReDim arr(1 To mylen)
   
6.         For k = 1 To mylen
   
7.             arr(k) = Val(Mid(Cells(i, 2), k))
   
8.         Next k
   
9.         myyear = Application.Max(arr)
   
10.         Cells(i, 6).Value = Left(Cells(i, 3), Len(Cells(i, 3)) - 4) & "-" & myyear & "-" & "<1," & Cells(i, 5) & ",1,False,False>.htm"
    
11.         Erase arr
    
12.     Next i
    
13. End Sub

复制代码

浪子神剑

回复 mn860429 的帖子

不错,但还有个小毛病,就是如果行数设定超过已有的行数的话,或者中间要是有空行,就是只要遇到空行,就会提示"下标越界".

mn860429

回复 浪子神剑 的帖子

可以加个if判读，如果为空则跳过该行