各位老师,帮我看看这个要怎么才能实现

珈璇9394

各位老师,帮我看看这个要怎么才能实现谢谢

jiangxiaoyun

1. Sub ggg()
   
2.     Dim arr
   
3.     arr = Range("a2:d" & Cells(Rows.Count, 1).End(xlUp).Row)
   
4.     Dim brr(1 To 55555, 1 To 4)
   
5.     For i = 1 To UBound(arr)
   
6.         d = DateDiff("m", arr(i, 2), arr(i, 4))
   
7.         y = Year(arr(i, 2))
   
8.         m = Month(arr(i, 2))
   
9.         For j = 1 To d
   
10.             k = k + 1
    
11.             brr(k, 1) = arr(i, 1)
    
12.             brr(k, 2) = arr(i, 3) / d
    
13.             brr(k, 3) = m
    
14.             brr(k, 4) = y
    
15.         Next
    
16.     Next
    
17.     [g2].Resize(k, 4) = brr
    
18. End Sub
    

复制代码

珈璇9394

jiangxiaoyun 发表于 2020-2-26 22:42

老师,好像不行哦

fdexcel

自定义函数
Function abc(x1 As Range) As Double
Dim s As String
Dim arr, arr1, n, i, nt

s = x1.Value

nt = 0

arr = Split(s, ",")

n = UBound(arr, 1)


For i = 0 To n

    arr1 = Split(arr(i), "~")
    If UBound(arr1) = 1 Then

        nt = Split(arr1(1), "No")(1) - Split(arr1(0), "No")(1) + nt


    End If


Next

abc = n + nt + 1


End Function