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

svinayoko

高个子 发表于 2022-11-17 20:22
19楼附件是有编码的，如果没有编码的代码应该是这样的

感谢老师。现在的问题是，数据不能复写。比如说在11月17号，数据为100,11月18日，数据变为了200，代码就不会再次对当期数据进行重新取值覆盖了。

高个子

svinayoko 发表于 2022-11-17 20:43
感谢老师。现在的问题是，数据不能复写。比如说在11月17号，数据为100,11月18日，数据变为了200，代码就 ...

今天11/17写了100，明天再写数据不改么？

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

复制代码

svinayoko

高个子 发表于 2022-11-17 21:13
今天11/17写了100，明天再写数据不改么？

sheet1的数据是每天都在变化的，但是sheet2的按钮事件，只能执行一次。再执行的时候，数据不会随着sheet1的变化而变化。

高个子

svinayoko 发表于 2022-11-17 21:46
sheet1的数据是每天都在变化的，但是sheet2的按钮事件，只能执行一次。再执行的时候，数据不会随着sheet1 ...

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

复制代码

svinayoko

高个子 发表于 2022-11-17 21:52

老师，代码刷新数据，没有反应的。

高个子

svinayoko 发表于 2022-11-17 22:03
老师，代码刷新数据，没有反应的。

你不就是想要录入之后就自动保存，不会因为后续的数据录入导致之前月份的数据被修改的吗？

svinayoko

高个子 发表于 2022-11-18 09:04
你不就是想要录入之后就自动保存，不会因为后续的数据录入导致之前月份的数据被修改的吗？

老师，是这样的。录入保存的逻辑是，当时间跨度过了15号，之前的数据就会被保存不会刷新。就比如现在录入的是11月的列，在12月15日之前，11月的数据都会根据sheet1变化。但是当12月15号之后，11月数据被保存不会被更改了。

高个子

svinayoko 发表于 2022-11-18 09:22
老师，是这样的。录入保存的逻辑是，当时间跨度过了15号，之前的数据就会被保存不会刷新。就比如现在录入 ...

好吧，那就这段吧，还帮你压缩了好几行代码

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.     For i = 1 To UBound(arr, 2)
   
5.         If Format(Month(CDate(Format(Now - 14, "yyyy-m-\1"))), "00月") = arr(1, i) Then
   
6.             For j = 1 To UBound(arr)
   
7.                 For k = 2 To UBound(brr)
   
8.                     If arr(j, 2) = brr(k, 3) And brr(k, 11) <> "" Then
   
9.                         arr(j, i) = brr(k, 11)
   
10.                     ElseIf arr(j, 2) = brr(k, 3) And brr(k, 11) = "" Then
    
11.                         arr(j, i) = brr(k, 8) - brr(k, 9)
    
12.                     End If
    
13.                 Next
    
14.             Next
    
15.         End If
    
16.     Next
    
17.     Sheet2.Range("a1:o" & Sheet2.Cells(Rows.Count, 1).End(xlUp).Row) = arr
    
18. End Sub
    

复制代码

svinayoko

高个子 发表于 2022-11-18 10:19
好吧，那就这段吧，还帮你压缩了好几行代码

老师，代码运行的时候，不知道是哪里的问题，sheet2相关单元格没有取到值。您看一下

高个子

svinayoko 发表于 2022-11-18 11:10
老师，代码运行的时候，不知道是哪里的问题，sheet2相关单元格没有取到值。您看一下

数据源的B列是文本，sheet2是常规，加一段代码把sheet2变成文本就可以了

1. Sub kdy()
   
2.     Sheet2.Range("B:B").TextToColumns Destination:=Range("B1"), DataType:=xlDelimited, _
   
3.     TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
   
4.     Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
   
5.     :=Array(1, 2), TrailingMinusNumbers:=True
   
6.    
   
7.     arr = Sheet2.Range("a1:o" & Sheet2.Cells(Rows.Count, 1).End(xlUp).Row)
   
8.     brr = Sheet1.Range("a1:k" & Sheet1.Cells(Rows.Count, 1).End(xlUp).Row)
   
9.     For i = 1 To UBound(arr, 2)
   
10.         If Format(Month(CDate(Format(Now - 14, "yyyy-m-\1"))), "00月") = arr(1, i) Then
    
11.             For j = 1 To UBound(arr)
    
12.                 For k = 2 To UBound(brr)
    
13.                     If arr(j, 2) = brr(k, 3) And brr(k, 11) <> "" Then
    
14.                         arr(j, i) = brr(k, 11)
    
15.                     ElseIf arr(j, 2) = brr(k, 3) And brr(k, 11) = "" Then
    
16.                         arr(j, i) = brr(k, 8) - brr(k, 9)
    
17.                     End If
    
18.                 Next
    
19.             Next
    
20.         End If
    
21.     Next
    
22.     Sheet2.Range("a1:o" & Sheet2.Cells(Rows.Count, 1).End(xlUp).Row) = arr
    
23. End Sub
    

复制代码