请告诉我以下问题,我已经为此工作了 3 个月,但我无法理解它。
我必须解释整个项目,以便您能够理解我希望我的代码做什么:
我创建了一个用于数据输入的用户表单,它将由 3 个用户同时使用,PC 上的每个用户都有相同的 Excel 工作簿“ENTRY APPLICATION”,并且数据输入到名为“NEW ROUND”的工作表中每个用户数据例如,条目的序列号以 1 - 1000 开头。共享文件夹中的另一个工作簿将 3 个用户输入的所有数据复制并粘贴到共享工作簿“DATABASE”上,然后将“DATABASE”上收集的数据再次复制并粘贴到同一工作簿上” ENTRY APPLICATION”用于用户,但在另一张表中,以便在排序时镜像到用户的共享工作簿,以便为每个用户正确排序数据的序列号,因为我为 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