VBA自动复制问题

Banieliang

LGBC_Lines_Performance_Updated_V14.rar (94.58 KB, 下载次数: 3)

2014-10-30 09:45 上传

点击文件名下载附件 大神，
请教问题，为什么我的程序会在一个时间点（时间点为下面设置的时间）自动复制6那么多次，谢谢！！收到设置程序，或者把时间每隔几分钟复制一次，复制都是单一性的，但是在我设置的00:03:30，08:03:30，16:03:30有时会触发多次复制，有时有单一的复制，这是为什么？在Rejectdata的sheet里面从时间或数据相同点可以看出来复制了6次之多。

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Call config
End Sub
Private Sub Workbook_Open()
ThisWorkbook.Worksheets("ConfigPage").Range("C2").Formula = ActiveWorkbook.Name
ThisWorkbook.Worksheets("ConfigPage").Range("C3").Formula = ActiveSheet.Name
Call aa
Call aa1
End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Sub aa()
Application.OnTime TimeValue("16:03:10"), "Elitefuzhi1"
End Sub
Sub bb()
Application.OnTime TimeValue("00:03:30"), "Elitefuzhi2"
End Sub
Sub cc()
Application.OnTime TimeValue("08:03:30"), "Elitefuzhi3"
End Sub
Sub aa1()
Application.OnTime TimeValue("15:59:58"), "Dartfuzhi1"
End Sub
Sub bb1()
Application.OnTime TimeValue("23:59:58"), "Dartfuzhi2"
End Sub
Sub cc1()
Application.OnTime TimeValue("07:59:58"), "Dartfuzhi3"
End Sub
Sub Elitefuzhi1()
Application.ScreenUpdating = False
Call config
Call Elite
Call bb
End Sub
Sub Elitefuzhi2()
Application.ScreenUpdating = False
Call config
Call Elite
Call cc
End Sub
Sub Elitefuzhi3()
Application.ScreenUpdating = False
Call config
Call Elite
Call aa
End Sub
Sub Dartfuzhi1()
Application.ScreenUpdating = False
Call config
Call Dart
Call bb1
End Sub
Sub Dartfuzhi2()
Application.ScreenUpdating = False
Call config
Call Dart
Call cc1
End Sub
Sub Dartfuzhi3()
Application.ScreenUpdating = False
Call config
Call Dart
Call aa1
End Sub
Sub Dayshift()
Call config
Call aa
Call aa1
End Sub
Sub Midshift()
Call config
Call bb
Call bb1
End Sub
Sub Night()
Call config
Call cc
Call cc1
End Sub

Sub Elite()
ActiveSheet.Unprotect
Dim wb As Workbook
Dim myname As String
Set wb = ThisWorkbook
Application.ScreenUpdating = False
myname = ThisWorkbook.Worksheets("ConfigPage").Range("C2").Formula
Workbooks(myname).Activate ''''If ActiveWindow.WindowState = xlMinimized Then
ActiveWindow.WindowState = xlMaximized Else
If Sheets("RejectData").Activate = False Then
Sheets("RejectData").Activate = True  'End If
End If
    Sheets("RejectData").Range("C3:D50").Select
    Selection.Copy
    Sheets("RejectData").Range("F3:G50").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("RejectData").Range("H3:I50").Select
    Selection.Insert Shift:=xlToRight
    Application.CutCopyMode = False
   ' Set ThisWorkbook = Nothing
Call ReloadData
Sheets("BC _RealTime_Monitor").Activate
   'Application.ScreenUpdating = True
   Set wb = Nothing
  ' Call MainPage
End Sub
Sub Dart()
ActiveSheet.Unprotect
Dim wb As Workbook
Dim myname As String
Set wb = ThisWorkbook
Application.ScreenUpdating = False
myname = ThisWorkbook.Worksheets("ConfigPage").Range("C2").Formula
Workbooks(myname).Activate
If ActiveWindow.WindowState = xlMinimized Then
ActiveWindow.WindowState = xlMaximized
Else
If Sheets("RejectData").Activate = False Then
Sheets("RejectData").Activate = True  'End If
End If
   Sheets("RejectData").Range("C52:D67").Select
    Selection.Copy
    Sheets("RejectData").Range("F52:G67").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("RejectData").Range("H52:I67").Select
    Selection.Insert Shift:=xlToRight
   ' Set ThisWorkbook = Nothing
   Application.CutCopyMode = False
Call ReloadData
'Application.ScreenUpdating = True
Sheets("BC _RealTime_Monitor").Activate
Set wb = Nothing
  
End Sub

''''''''''''''''''''''''reload Last Three shift Data''''''''''''''''''''''''
Sub ReloadData()
Application.ScreenUpdating = False
Sheets("RejectTop").Activate
Dim i As Integer
For i = 4 To 67
    Sheets("RejectTop").Range("C" & i).Select
    ActiveCell.FormulaR1C1 = "=RejectData!R[-1]C[5]"
    Sheets("RejectTop").Range("D" & i).Select
    ActiveCell.FormulaR1C1 = "=RejectData!R[-1]C[5]"
     Sheets("RejectTop").Range("E" & i).Select
    ActiveCell.FormulaR1C1 = "=RejectData!R[-1]C[5]"
     Sheets("RejectTop").Range("F" & i).Select
    ActiveCell.FormulaR1C1 = "=RejectData!R[-1]C[5]"
     Sheets("RejectTop").Range("G" & i).Select
    ActiveCell.FormulaR1C1 = "=RejectData!R[-1]C[5]"
     Sheets("RejectTop").Range("H" & i).Select
    ActiveCell.FormulaR1C1 = "=RejectData!R[-1]C[5]"
     Sheets("RejectTop").Range("I" & i).Select
    ActiveCell.FormulaR1C1 = "=RejectData!R[-1]C[5]"
     Sheets("RejectTop").Range("J" & i).Select
    ActiveCell.FormulaR1C1 = "=RejectData!R[-1]C[5]"
    Next
End Sub
Sub config()
ThisWorkbook.Worksheets("ConfigPage").Range("C2").Formula = ActiveWorkbook.Name
ThisWorkbook.Worksheets("ConfigPage").Range("C3").Formula = ActiveSheet.Name
If ThisWorkbook.Worksheets("ConfigPage").Range("WZZ5").Value <> "" Then
ThisWorkbook.Worksheets("BC _RealTime_Monitor").Range("N1").Formula = "Data Full"
End If
End Sub
Sub DataClear()
'RejectData Clear
ThisWorkbook.Worksheets("RejectData").Range("T1:WZZ100").Formula = ""
End Sub

hwc2ycy

电脑从早到晚开着运行EXCEL？
在相关的复制过程里结束前加一句debug.print来输出当前的过程名与时间，完事再来看吧。

Banieliang

hwc2ycy 发表于 2014-10-30 10:15
电脑从早到晚开着运行EXCEL？
在相关的复制过程里结束前加一句debug.print来输出当前的过程名与时间，完事 ...

电脑从早到晚开着运行EXCEL？
--是的！！！
在相关的复制过程里结束前加一句debug.print来输出当前的过程名与时间，完事
能否附程序？？
谢谢！！！

hwc2ycy

aa-->elitefuzhi1-->bb-->elitefuzhi2-->cc-->elitefuzhi3-->aa
aa1-->dartfuzhi1-->bb1-->Dartfuzhi2-->cc1-->Dartfuzhi3-->aa1

调用逻辑，这不正好是6次么。

hwc2ycy

顺滕摸瓜，一个个过程看一次就明白。复制的代码不用去看，都在那几个aa,bb,cc里转来转去。
然后aa,bb,cc里又再次去调用相关的复制代码。