数据填写

lgzxmlg

根据日期判断，填写数据，不要影响到其它数据 数据填写.zip (28.16 KB, 下载次数: 5)

2019-2-16 07:31 上传

点击文件名下载附件

lsc900707

了解一下字典的相关知识。

lgzxmlg

lsc900707 发表于 2019-2-16 07:42
了解一下字典的相关知识。

请帮忙处理下，谢谢

liulang0808

楼主模拟案例都没有，仅有一段描述：
1.根据【A】列与【AC】列日期判断，将[AH]列数填写到【S】列。
2.根据【A】列与【AJ】列日期判断，将[AM]列数填写到【O】列。
3.根据【A】列与【AR】列日期判断，将[AU]列数填写到【P】列


根据【A】列与【AC】列日期判断，这个是怎么判断啊？相等，大于，小于多少天，还是。。。。。

liulang0808

Sub 取数()
    arr = Application.Intersect(ActiveSheet.UsedRange, Rows("1:34"))
    Set d = CreateObject("scripting.dictionary")
    Application.ScreenUpdating = False
    For j = 4 To UBound(arr)
        If VBA.IsDate(arr(j, 1)) Then d(CDate(arr(j, 1))) = j
    Next j
    For j = 4 To UBound(arr)
        If d.exists(CDate(arr(j, 29))) Then
            Cells(d(CDate(arr(j, 29))), "s") = arr(j, 34)
        End If
    Next j
    Application.ScreenUpdating = True
End Sub
这个是根据楼主的  时间相等，进行处理的，返回s列数据，其他列，楼主可以参考的

chxw68

1. Sub test()
   
2.   Dim r%, i%
   
3.   Dim arr, brr
   
4.   Dim d As Object
   
5.   Set d = CreateObject("scripting.dictionary")
   
6.   vs = [{29,34,19;36,39,15;44,47,16}]
   
7.   With Worksheets("消耗分析")
   
8.     For k = 1 To UBound(vs)
   
9.       r = .Cells(.Rows.Count, vs(k, 1)).End(xlUp).Row
   
10.       c = .Cells(3, vs(k, 1) + 1).End(xlToRight).Column
    
11.       arr = .Range(.Cells(4, vs(k, 1)), .Cells(r, c))
    
12.       For i = 1 To UBound(arr)
    
13.         rq = CDate(arr(i, 1))
    
14.         If Len(rq) <> 0 Then
    
15.           If Not d.exists(rq) Then
    
16.             ReDim brr(1 To UBound(vs))
    
17.           Else
    
18.             brr = d(rq)
    
19.           End If
    
20.           brr(k) = arr(i, vs(k, 2) - vs(k, 1) + 1)
    
21.           d(rq) = brr
    
22.         End If
    
23.       Next
    
24.     Next
    
25.     r = .Cells(4, 1).End(xlDown).Row
    
26.     arr = .Range("a4:z" & r)
    
27.     For i = 1 To UBound(arr)
    
28.       If d.exists(arr(i, 1)) Then
    
29.         brr = d(arr(i, 1))
    
30.         For j = 1 To UBound(brr)
    
31.           arr(i, vs(j, 3)) = brr(j)
    
32.         Next
    
33.       End If
    
34.     Next
    
35.     .Range("a4:z" & r) = arr
    
36.   End With
    
37. End Sub
    

复制代码

lgzxmlg

liulang0808 发表于 2019-2-16 08:30
楼主模拟案例都没有，仅有一段描述：
1.根据【A】列与【AC】列日期判断，将[AH]列数填写到【S】列。
2.根 ...

日期相同提取

chxw68

没有一个日期能匹配上。

lgzxmlg

liulang0808 发表于 2019-2-16 08:30
楼主模拟案例都没有，仅有一段描述：
1.根据【A】列与【AC】列日期判断，将[AH]列数填写到【S】列。
2.根 ...

1.【A】列=【AC】列日期，将[AH]列数填写到【S】列。
2.【A】列=【AJ】列日期，将[AM]列数填写到【O】列。
3.【A】列=【AR】列日期，将[AU]列数填写到【P】列。

lgzxmlg

chxw68 发表于 2019-2-16 08:36
没有一个日期能匹配上。

谢谢老师帮忙，问题解决。