请与我裸露我下面的问题,我一直在这3个月的工作,我不能得到我的头周围。
我必须解释整个项目,以便您可以理解我希望我的代码做什么:
我已经创建了一个用户表单,这是数据输入,它将由3个用户在同一时间使用,每个用户在PC上有相同的Excel工作簿“输入应用程序”和数据输入一张名为“新回合”每个用户数据条目有一个序列号,例如1 - 1000开始。以及共享文件夹上的另一个工作簿,该共享文件夹用于将由3个用户输入的所有数据复制并粘贴到共享工作簿“DATABASE”上,然后将“数据库”上收集的数据再次复制并粘贴到同一工作簿“入学申请”上但在另一个工作表中,以便在排序时镜像到用户的共享工作簿,从而对数据的序列号进行排序正确的为每个用户,FOT,我有相同的工作簿为3个用户,但每个人只是改变了他们的范围,使他们的数据被复制的范围,使他们不清除其他用户的数据条目,例如:用户1的粘贴范围是A1:N2000,用户2的粘贴范围是A2001:N4000,用户3的粘贴范围是A4001:N6000,然后当再次粘贴到其工作簿中时,它们都被分类,该工作簿是具有用户表单的“数据应用程序”。
“数据库”工作簿,这是共享的,所有收集的数据都在其中,以防止重复条目的用户(这是在一个不同的模块),但现在我的斗争是我试图有更少的时间和更有效地完成,使我不必使用屏幕更新和打开激活保存关闭工作簿的所有时间,这可能会使工作缓慢,可能会崩溃。
我已经读到了一个伟大的线程在这里现在关于父对象,显然保存了大量的时间和错误,为我同样的需要,但我不知道什么,所以以往任何时候都如何反映在我的用户表单工作簿,以及如何调整我的代码。
请帮我调整一下我的代码,希望我解释的正确。
Sub DATA_BASE_ARCHIVE_FullArchive()
Application.ScreenUpdating = False
Windows("ENTRY APPLICATION.xlsm").Activate
Sheets("NEWROUND").Select
Range("A1:N2000").Select
Selection.Copy
Workbooks.Open filename:= _
"\\2-2023\DATABASE.xlsm"
Windows("DATABASE.xlsm").Activate
Range("A2001").Select
Sheets("FullArchive").Paste
Cells.Select
Range("A2001").Activate
Application.CutCopyMode = False
Selection.Copy
Windows("ENTRY APPLICATION.xlsm").Activate
Sheets("ARCHIVE").Select
Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveWorkbook.Worksheets("ARCHIVE").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("ARCHIVE").Sort.SortFields.ADD Key:=Columns("L:L") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("ARCHIVE").Sort.SortFields.ADD Key:=Columns("A:A") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("ARCHIVE").Sort
.SetRange Columns("A:P")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Windows("DATABASE.xlsm").Activate
ActiveWorkbook.Save
ActiveWindow.Close
Application.CutCopyMode = False
Windows("ENTRY APPLICATION.xlsm").Activate
Sheets("FORM").Select
End Sub
请原谅我复杂的解释,但是我正在做的事情已经够复杂的了!所以请帮帮忙谢谢。
根据我从@stringeater收到的第一个答案编辑的代码。请检查一下然后帮我调整一下。我只是得到一个错误,现在在setwbkDATABAS = Nothing
Sub DATA_BASE_ARCHIVE_FullArchive()
Dim rngNEWROUND As Excel.Range
Dim arrNEWROUND As Variant
Dim wbkDATABASE As Excel.Workbook
Dim rngDataTarget As Excel.Range
Dim rngDataSource As Excel.Range
Dim varData As Variant
Dim rngArchive As Excel.Range
Application.ScreenUpdating = False
Set rngNEWROUND = ThisWorkbook.Sheets("NEWROUND").Range("A1:N2000")
arrNEWROUND = ThisWorkbook.Sheets("NEWROUND").Range("A1:N2000")
Set wbkDATABASE = Workbooks.Open(filename:="E:\DELEGATION APPLICATION SAMPLE\2-2023\DATABASE.xlsm")
Set rngDataTarget = wbkDATABASE.Sheets("FullArchive").Range("A2001")
Set rngDataTarget = rngDataTarget.Resize(UBound(arrNEWROUND, 1), UBound(arrNEWROUND, 2))
rngDataTarget.Value = arrNEWROUND
Set rngDataSource = rngDataTarget.Worksheet.Range("A2001")
varData = rngDataSource.Value
wbkDATABASE.Save
wbkDATABASE.Close
setwbkDATABASE = Nothing '(and Im getting error here)
Set rngArchive = ThisWorkbook.Sheets("ARCHIVE").Range("A1") 'reference range
rngArchive.Value = varData
ThisWorkbook.Worksheets("ARCHIVE").Sort.SortFields.Clear
ThisWorkbook.Worksheets("ARCHIVE").Sort.SortFields.ADD Key:=Columns("L:L"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ThisWorkbook.Worksheets("ARCHIVE").Sort.SortFields.ADD Key:=Columns("A:A"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ThisWorkbook.Worksheets("ARCHIVE").Sort
.SetRange Columns("A:P")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Application.ScreenUpdating = True
Sheets("FORM").Select
End Sub
2条答案
按热度按时间zte4gxcn1#
我已经注解掉了你的代码行,并把我的代码行放在下面,这样你就可以看到如何“翻译”你的代码。您可以进一步缩短代码,但代码可能不会变得更容易理解。
waxmsbnn2#
因为我没有你的样本和所有的密码,我只能想象。请尝试使用Range object而不是Selection,除非你想看到它在运行时运行,否则,没有必要刷新屏幕。在您的代码中:
应用程序。屏幕更新= False
ScreenUpdating = False你还说
这样我就不必一直使用屏幕更新和打开、保存、关闭工作簿。这样我就不必一直使用screenupdate和打开激活保存关闭工作簿,这会使工作变慢甚至可能崩溃。
此外:
我希望一种更非人类的方法更快、更有效
因此,最好使用Range代替Selection来实现。这与Word和PowerPointVBA中的原理相同。* 除非你需要刷新屏幕,或者某些东西需要有焦点来进行操作,否则你实际上不应该使用Selection。* 我认为@Stringeater楼上的回答已经做到了这一点,所以他注解掉了你的Selection语句,并使用下面的Range对象来执行它。
如果您仍然不清楚或有疑问,请再次告诉我们。
20230527 12:59 (CST)
如果您只想将结果保存为Excel文件(带或不带代码),这很容易做到。最简单的方法是将其保存在本地,然后用CopyFile method覆盖目标文件。如果本地保存是不可能的,只允许另存为,那么ExcelVBA中的SaveAs方法将不得不使用。多任务阅读冲突的研究更为复杂。我相信@Stringeater会想出一个很好的解决方案,就像他以前做的那样。谢谢你