[已解决]自动填充时间问题

yanchuenlei

因为sheet2到6数据比较大，当SHEET1确认修改时 ，因为SHEET2到6本表的自动填充时间而导致确认修改很慢，希望大神优化一下

最佳答案

月排行榜 / 总排行榜

cutecpu

2021-4-12 18:48

yanchuenlei 发表于 2021-4-12 18:10
原本没有  修改后我测试时候输入的

藍色部份，新增、修改！

Sub mo()
   If Sheet1.OptionButton1 Then Set sjsht = Sheet5
   If Sheet1.OptionButton2 Then Set sjsht = Sheet3
   If Sheet1.OptionButton3 Then Set sjsht = Sheet2
   If Sheet1.OptionButton4 Then Set sjsht = Sheet4
   If Sheet1.OptionButton5 Then Set sjsht = Sheet6
   a = Range("a5:aw" & Cells(Rows.Count, 1).End(xlUp).Row)
   With sjsht
      b = .Range("a3:aw" & .Cells(Rows.Count, 1).End(xlUp).Row)
   End With
   Set d = CreateObject("Scripting.Dictionary")
   For i = 1 To UBound(a)
      d.Add a(i, 3) & "," & a(i, 6), i
      For j = 17 To 27
         If a(i, j) <> "" Then a(i, j + 22) = Now
      Next
   Next
   For i = 1 To UBound(b)
      Key = b(i, 3) & "," & b(i, 6)
      If d.exists(Key) Then
         r = d(Key)
         For j = 1 To UBound(a, 2)
            b(i, j) = a(r, j)
         Next
      End If
   Next
   Application.EnableEvents = False
   sjsht.Range("a3").Resize(UBound(b), UBound(b, 2)) = b
   Application.EnableEvents = True
   Sheet1.Range("a5").Resize(UBound(a), UBound(a, 2)).ClearContents

End Sub

祝順心，南無阿彌陀佛！

跳转到最佳答案楼层

cutecpu

Sub mo()
   If Sheet1.OptionButton1 Then Set sjsht = Sheet5
   If Sheet1.OptionButton2 Then Set sjsht = Sheet3
   If Sheet1.OptionButton3 Then Set sjsht = Sheet2
   If Sheet1.OptionButton4 Then Set sjsht = Sheet4
   If Sheet1.OptionButton5 Then Set sjsht = Sheet6
   a = Range("a5:aa" & Cells(Rows.Count, 1).End(xlUp).Row)
   With sjsht
      b = .Range("a3:aa" & .Cells(Rows.Count, 1).End(xlUp).Row)
   End With
   Set d = CreateObject("Scripting.Dictionary")
   For i = 1 To UBound(a)
      d.Add a(i, 3) & "," & a(i, 6), i
   Next
   For i = 1 To UBound(b)
      Key = b(i, 3) & "," & b(i, 6)
      If d.exists(Key) Then
         r = d(Key)
         For j = 1 To UBound(a, 2)
            b(i, j) = a(r, j)
         Next
      End If
   Next
   sjsht.Range("a3").Resize(UBound(b), UBound(b, 2)) = b
   Sheet1.Range("a5").Resize(UBound(a), UBound(a, 2)).ClearContents
End Sub

祝順心，南無阿彌陀佛！

cutecpu

沒有看到你有用 Worksheet_Change
新增藍色部份代碼

Sub mo()

   If Sheet1.OptionButton1 Then Set sjsht = Sheet5
   If Sheet1.OptionButton2 Then Set sjsht = Sheet3
   If Sheet1.OptionButton3 Then Set sjsht = Sheet2
   If Sheet1.OptionButton4 Then Set sjsht = Sheet4
   If Sheet1.OptionButton5 Then Set sjsht = Sheet6
   a = Range("a5:aa" & Cells(Rows.Count, 1).End(xlUp).Row)
   With sjsht
      b = .Range("a3:aa" & .Cells(Rows.Count, 1).End(xlUp).Row)
   End With
   Set d = CreateObject("Scripting.Dictionary")
   For i = 1 To UBound(a)
      d.Add a(i, 3) & "," & a(i, 6), i
   Next
   For i = 1 To UBound(b)
      Key = b(i, 3) & "," & b(i, 6)
      If d.exists(Key) Then
         r = d(Key)
         For j = 1 To UBound(a, 2)
            b(i, j) = a(r, j)
         Next
      End If
   Next
   Application.EnableEvents = False
   sjsht.Range("a3").Resize(UBound(b), UBound(b, 2)) = b
   Application.EnableEvents = True
   Sheet1.Range("a5").Resize(UBound(a), UBound(a, 2)).ClearContents

End Sub


祝順心，南無阿彌陀佛！

yanchuenlei

cutecpu 发表于 2021-4-12 13:29
Sub mo()
   If Sheet1.OptionButton1 Then Set sjsht = Sheet5
   If Sheet1.OptionButton2 Then Set sj ...

yanchuenlei

cutecpu 发表于 2021-4-12 14:24
沒有看到你有用 Worksheet_Change
新增藍色部份代碼

大神 SHEET2,3,4,5,6日期不自动填充了

cutecpu

yanchuenlei 发表于 2021-4-12 14:40
大神 SHEET2,3,4,5,6日期不自动填充了

您好，可以舉個例子嗎

yanchuenlei

cutecpu 发表于 2021-4-12 15:28
您好，可以舉個例子嗎

钓鱼台A表 有自动填充日期的代码 如Q列出现数据  AM应该自动录入当前日期 现在在表一里面输入1111确认修改之后 钓鱼台A表AM列不自动录入当前时间

cutecpu

yanchuenlei 发表于 2021-4-12 16:45
钓鱼台A表 有自动填充日期的代码 如Q列出现数据  AM应该自动录入当前日期 现在在表一里面输入1111确认修 ...

Q 列的數據 是原本就有的，還是修改後才有的？

yanchuenlei

cutecpu 发表于 2021-4-12 16:56
Q 列的數據 是原本就有的，還是修改後才有的？

原本没有  修改后我测试时候输入的

cutecpu

yanchuenlei 发表于 2021-4-12 18:10
原本没有  修改后我测试时候输入的

藍色部份，新增、修改！

Sub mo()
   If Sheet1.OptionButton1 Then Set sjsht = Sheet5
   If Sheet1.OptionButton2 Then Set sjsht = Sheet3
   If Sheet1.OptionButton3 Then Set sjsht = Sheet2
   If Sheet1.OptionButton4 Then Set sjsht = Sheet4
   If Sheet1.OptionButton5 Then Set sjsht = Sheet6
   a = Range("a5:aw" & Cells(Rows.Count, 1).End(xlUp).Row)
   With sjsht
      b = .Range("a3:aw" & .Cells(Rows.Count, 1).End(xlUp).Row)
   End With
   Set d = CreateObject("Scripting.Dictionary")
   For i = 1 To UBound(a)
      d.Add a(i, 3) & "," & a(i, 6), i
      For j = 17 To 27
         If a(i, j) <> "" Then a(i, j + 22) = Now
      Next
   Next
   For i = 1 To UBound(b)
      Key = b(i, 3) & "," & b(i, 6)
      If d.exists(Key) Then
         r = d(Key)
         For j = 1 To UBound(a, 2)
            b(i, j) = a(r, j)
         Next
      End If
   Next
   Application.EnableEvents = False
   sjsht.Range("a3").Resize(UBound(b), UBound(b, 2)) = b
   Application.EnableEvents = True
   Sheet1.Range("a5").Resize(UBound(a), UBound(a, 2)).ClearContents

End Sub

祝順心，南無阿彌陀佛！