各位大佬，咨询一个按照时间延期填列的问题。

svinayoko

各位大神，如附件，如何用VBA代码实现：根据sheet1的“物料编码”，计算“本期入库单（H）和本期出库单(I)差值的绝对值，填在sheet2的表格里，sheet2的表格填列是按照系统当前时间推前15天，例如系统时间是2月15号之前的，数据就填列在1月的列里面。以此类推。这个表格太大了，用VLookup函数太慢了，要处理很久很久，谢谢大神

高个子

手动做两个结果再发上来吧

svinayoko

高个子 发表于 2022-11-13 19:07
手动做两个结果再发上来吧

对不起，之前发的附件有问题。现在我改过来了。sheet2数据的录入范围是按照每个月15号为界线。11月15日之前操作的话，数据就录入到10月的单元格里，12月15日之前操作的话，数据就录入到11月的单元格里。录入之后就自动保存，不会因为后续的数据录入导致之前月份的数据被修改。这个想法能实现吗？

高个子

svinayoko 发表于 2022-11-13 20:17
对不起，之前发的附件有问题。现在我改过来了。sheet2数据的录入范围是按照每个月15号为界线。11月15日之 ...

15日之后操作会怎么样呢？

svinayoko

高个子 发表于 2022-11-14 10:20
15日之后操作会怎么样呢？

每个月15日之后的操作，数据会录入到当月，比如，系统时间11月15日之前，数据就会被写入10月的列，15日之后数据就会被写入到11月的列

高个子

svinayoko 发表于 2022-11-15 08:21
每个月15日之后的操作，数据会录入到当月，比如，系统时间11月15日之前，数据就会被写入10月的列，15日之 ...

哦哦明白了，我想想看

svinayoko

高个子 发表于 2022-11-15 10:33
哦哦明白了，我想想看

谢谢老师，静待佳音！

高个子

svinayoko 发表于 2022-11-15 10:38
谢谢老师，静待佳音！

1. Sub kdy()
   
2.     arr = Sheet2.Range("a1:o" & Sheet2.Cells(Rows.Count, 1).End(xlUp).Row)
   
3.     brr = Sheet1.Range("a1:k" & Sheet1.Cells(Rows.Count, 1).End(xlUp).Row)
   
4.     If Day(Now) <= 15 Then
   
5.         For i = 1 To UBound(arr, 2)
   
6.             If Format(Month(Now) - 1, "00月") = arr(1, i) Then
   
7.                 For j = 1 To UBound(arr)
   
8.                     For k = 2 To UBound(brr)
   
9.                         If arr(j, 1) = brr(k, 3) And brr(k, 11) <> "" Then
   
10.                             arr(j, i) = brr(k, 11)
    
11.                         ElseIf arr(j, 2) = brr(k, 3) And brr(k, 11) = "" Then
    
12.                             arr(j, i) = brr(k, 8) - brr(k, 9)
    
13.                         End If
    
14.                     Next
    
15.                 Next
    
16.             End If
    
17.         Next
    
18.     Else
    
19.         For l = 1 To UBound(arr, 2)
    
20.             If Format(Month(Now), "00月") = arr(1, l) Then
    
21.                 For m = 1 To UBound(arr)
    
22.                     For n = 1 To UBound(brr)
    
23.                         If arr(m, l) = brr(n, 3) And brr(n, 11) <> "" Then
    
24.                             arr(l, m) = brr(n, 11)
    
25.                         ElseIf arr(m, 2) = brr(n, 3) And brr(n, 11) = "" Then
    
26.                             arr(m, l) = brr(n, 8) - brr(n, 9)
    
27.                         End If
    
28.                     Next
    
29.                 Next
    
30.             End If
    
31.         Next
    
32.     End If
    
33.     Sheet2.Range("a1:o" & Sheet2.Cells(Rows.Count, 1).End(xlUp).Row) = arr
    
34. End Sub
    

复制代码

svinayoko

高个子 发表于 2022-11-15 14:33

先感谢老师，再下载测试

svinayoko

高个子 发表于 2022-11-15 14:33

老师，您看一下，第二行和第四行，没有取值，正常是有值的。还有就是sheet2能不能依据sheet1的数据变化，进行数据覆盖更新。