我正在尝试创建一个宏，它将数据范围从当前打开的工作簿复制到存储在网络中的另一个工作簿上的第一个空行表。 （它就像我在我的文件中输入的数据的数据库一样）
我选择excel是因为它具有数据分析功能，因为必须连续监控和分析数据，并保存记录，每年最多可达100万行数据。
我应该用什么样的代码来实现这个目标？到目前为止，许多小时的搜索没有运气，任何帮助表示赞赏，谢谢！:)
P.S我将尝试将大约10个文件与数据链接到同一个文件（数据库），但由于其他人可能打开了数据库，是否会导致将信息粘贴到数据库时出现问题？
答案 0 :(得分：-1)
-edit：只为可能正在浏览解决方案的人添加解释。我们要做的主要是同时打开两个工作簿，并使用Windows(some_workbook).Activate在它们之间切换，其中some_workbook是工作簿的名称。可以使用ActiveWorkbook.Name找到它通常只是带扩展名的文件名（这是excel不允许您打开具有相同名称的工作簿的一个原因，即使路径不同，因为它只使用文件名作为句柄，它可以区分两个具有相同名称的物理上不同的文件）
如果一个工作簿未打开，我们使用workbook.open Filename:= "PATH_TO_WORKBOOK"，其中PATH_TO_WORKBOOK是您要打开的工作簿的完整路径。另请注意，它被引号
除了管理工作簿之外，您可能需要使用sheets(sheet_name).activate来管理工作表（除非您有一本简单的1本书），其中sheet_name是工作表的名称作为字符串。它也可以是纸张索引（适用于迭代多张纸）但通常不可靠，因为纸张订单可以混合，或者可以添加/删除纸张。当然用户可以更改工作表名称，但更容易防止，同时仍然赋予他们灵活性see here 'preventing users chaning sheetnames'
您还需要跟踪两个范围，您复制的范围和粘贴的范围。
完成所有操作后，它只是一个复制和粘贴操作
好的，这是你的解决方案。我去了vba并创建了两个模块。第一个是FILE_FUNCTIONS
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'this function opens the windows file explorer and allows
'the user to open a file
'PARAMS: N/A
'RETURN: the name of the file if the user picked a file
' OW returns ""
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function GuiOpenSpecifiedFile(file_dialog_title, _
Optional Txt_only As Boolean, Optional CSV_only As Boolean)
'this creates a filedialog object
Set my_fd = Application.FileDialog(msoFileDialogFilePicker)
With my_fd
'this sets the title
.Title = file_dialog_title
'this is so they can only pick one file at a time
.AllowMultiSelect = False
'this just makes sure they can select anyfile
.Filters.clear
'adds filters if specified
If (Not (IsMissing(Txt_only)) And Txt_only) Then
.Filters.Add "Text", "*.txt"
End If
If (Not (IsMissing(CSV_only)) And CSV_only) Then
.Filters.Add "CSV", "*.csv"
End If
'this makes the window pop up and saves the selected
'file to a variable
file_to_import = .Show
End With
'makes sure they actually chose a file
If (file_to_import <> 0) Then
'this takes the name of the file selected and stores
'it in a variable
GuiOpenSpecifiedFile = Trim(my_fd.SelectedItems(1))
Else
'return null value
GuiOpenSpecifiedFile = ""
End If
End Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'tells whether or not a specifc file exists
'PARAMS: the full path to the file, or the file name if it
' is in the same working directory
'RETURN: wthere the file exists
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function FileExists(sFile_path As String) As Boolean
'if file exists DIR returns the file name, or blank otherwise
'if you run DIR("") it returns the workbook title which has a len > 0
'so we also have to check the file name itsel
FileExists = ((Len(Dir(sFile_path)) > 0) And (Len(sFile_path) > 0))
End Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'this finds the last row in an excel worksheet
'PARAMS: Opt: sheet_name, the sheet you want to check last row of
' default is current sheet if not specified
'RETURN: the last row number used in the sheet
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function GetLastRow(Optional sheet_name As String)
'gets current sheet name
the_current_sheet = ActiveSheet.Name
'if the user specified a sheet, select it
If (Len(sheet_name) <> 0) Then
Sheets(sheet_name).Select
End If
'finds the last row
GetLastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
'returns to original sheet
Sheets(the_current_sheet).Select
End Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'this finds the last row in a specific column
'PARAMS: col_to_check, the clumn we want the last row of
' Opt: sheet_name, the sheet you want to check last row of
' default is current sheet if not specified
'RETURN: the last row number used in the sheet
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function GetLastRowByColumn(col_to_check As String, Optional sheet_name As String)
'gets current sheet name
the_current_sheet = ActiveSheet.Name
'if the user specified a sheet, select it
If (Len(sheet_name) <> 0) Then
Sheets(sheet_name).Select
End If
'gets last row
GetLastRowByColumn = Range(col_to_check & "65536").End(xlUp).Row
'returns to original sheet
Sheets(the_current_sheet).Select
End Function
'---------------------------------------------------------------------------------
'checks whether or not a sheet exists by looking for its name in the currently
'opened sheets
'PARAMS: sSheetName, as string of the sheetname you want to find
'RETURN: boolean, wehther sheet exists
'---------------------------------------------------------------------------------
Function SheetExists(ByVal sSheetName As String) As Boolean
Dim oSheet As Excel.Worksheet
Dim bReturn As Boolean
For Each oSheet In ActiveWorkbook.Sheets
If oSheet.Name = sSheetName Then
bReturn = True
Exit For
End If
Next oSheet
SheetExists = bReturn
End Function
所以将所有这些复制到模块中并将其命名为FILE_FUNCTIONS（它可以节省大量时间自行保存该模块并将其导入未来的项目中）
第二个模块有实际代码。这是您应该对sub＆＃34; Sub CopCellsFromSheetToDataBase＆＃34;进行更改的地方。获取db文件并设置列和范围
Function OpenWorkbook(spath_to_workbook)
'check if the file exists
If Not (FILE_FUNCTIONS.FileExists(CStr(spath_to_workbook))) Then
OpenWorkbook = ""
Exit Function
End If
'surrounds the file name with quotes as required
'spath_to_workbook = Chr(34) & spath_to_workbook & Chr(34)
Workbooks.Open Filename:=spath_to_workbook
'returns the name of the workbook
OpenWorkbook = ActiveWorkbook.Name
End Function
Sub CopyCellsFromSheetToDatabase()
Dim db_sheetname, db_record_col As String
'------------- start configuration -------------------
smy_range_to_copy = "A1:B2"
db_sheetname = CStr("AllRecords") 'cstr must be ppresent
db_record_col = "A"
sdb_filename = FILE_FUNCTIONS.GuiOpenSpecifiedFile("Please select the database file")
'or if you want it to simply be hardcoded you can do that
'sdb_filename = "c:\users\administrator\desktop\my_database.xlsx")
'-------------- end configuration ------------------
'if the user didn't select a file quit sub quietly
If Len(sdb_filename) = 0 Then
Exit Sub
End If
Application.StatusBar = "Copying to database"
Application.ScreenUpdating = False
'saves the workbook names
curr_workbook = ActiveWorkbook.Name
database_workbook = OpenWorkbook(sdb_filename)
'if we opened the file
If (Len(database_workbook) = 0) Then
MsgBox ("Unable to Open workbook " & sdb_filename)
Exit Sub
End If
'copies range
Windows(curr_workbook).Activate
Range(smy_range_to_copy).Select
Selection.Copy
'switches to db
Windows(database_workbook).Activate
'checks if the db_Sheet exists
If (Not (FILE_FUNCTIONS.SheetExists(db_sheetname))) Then
MsgBox ("Sheet: " + db_sheetname + vbLf + " not found in: " + sdb_filename)
ActiveWorkbook.Close
'activates the original workbook (in case you have many others open)
Windows(curr_workbook).Activate
'restores app settings
Application.StatusBar = ""
Application.ScreenUpdating = True
Exit Sub
End If
'use this if you want only the last row from a particular column and have a sheetname
last_row_of_db = FILE_FUNCTIONS.GetLastRowByColumn(db_record_col, CStr(db_sheetname))
'pastes the values
Range(db_record_col & CStr(last_row_of_db + 1)).Select
ActiveSheet.Paste
Application.CutCopyMode = False
'saves the db and closes it
ActiveWorkbook.Save
ActiveWindow.Close
'activates the original workbook (in case you have many others open)
Windows(curr_workbook).Activate
'returns control to excel
Application.StatusBar = ""
Application.ScreenUpdating = True
End Sub