提示用户打开工作簿并选择工作表,将打开一个空白文件



我希望用户选择一个工作簿,然后选择他们需要的工作表。代码在调试 - 单步执行时运行良好。但是,当通过按钮运行完整的宏时,文件确实会打开并提示选择工作表,但没有工作表或单元格可见。都是空白的。文件没有保护。列名和行号不可见

Sub LoadData()
Dim ws As Worksheet
Dim desiredSheetName As String
Dim c As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
ans = MsgBox("Choose the file to retrive the data?", vbYesNo, "Choose Source")
If ans = vbYes Then
myfile = Application.GetOpenFilename(, , "Browse for Workbook")
If myfile <> False Then
ThisWorkbook.Sheets("Destination").Range("AA2") = myfile
Set src_data = Workbooks.Open(myfile)
On Error Resume Next
desiredSheetName = InputBox("Select any cell inside the target sheet: ",type:=8).worksheet.name 
sht = desiredSheetName
On Error GoTo 0
Set dest = ThisWorkbook.Worksheets("Destination")
src_data.Activate
lastcell = src_data.Sheets(sht).Cells(Rows.Count, "C").End(xlUp).Row
LastRowD = dest.Cells(dest.Rows.Count, "F").End(xlUp).Offset(0).Row
src_data.Activate
Sheets(sht).Select
Range("A:B,D:D").Select
Selection.Copy
dest.Activate
Range("F1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, skipblanks:=False, Transpose:=False
src_data.Close False
dest.Select
End If
Else
Exit Sub
End If
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

在请求范围选择之前,您不需要关闭屏幕更新,因为当宏运行时,文件将打开,但屏幕不会更新以显示单元格。

给出代码的其他一些指针:

  • 您正在使用尚未声明的变量(shtsrcData(。
  • 如果只使用一次变量(如 MessageBox 中的变量ans(,只需直接插入该变量,而不是使变量变暗并使用它。例外情况是使用数字等常量时。在这种情况下,使用有意义的变量名称总是比没有上下文的硬编码数字更好。
  • 您应该在模块的顶部设置Option Explicit,您将 使用未声明的变量警告此问题。
  • 您正在destinationSheet,然后设置sht同样的事情。为什么不干脆摆脱sht呢?
  • 与其混合变量命名约定(src_datadesiredSheetName(,不如选择一个并坚持下去(我自己使用后一种格式(。
  • 选择和激活事物通常是错误的方法 除非您这样做,以便用户可以看到特定内容。 通常,您应该只对范围和工作表进行操作 他们自己。此外,您应该明确说明您正在使用的工作表(因为否则它默认为 ActiveSheet(。例如:

而不是:

Range("A:B,D:D").Select
Selection.Copy
dest.Activate
Range("F1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, skipblanks:=False, Transpose:=False

做:

src_data.Range("A:B,D:D").Copy
dest.Range("F1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, skipblanks:=False, Transpose:=False

这使得您非常清楚地从哪里复制和粘贴到哪里,代码行更少,处理速度也更快。

所以这是最终的代码,有明确命名的、定义的变量,没有Select工作表,没有使用的变量被剪掉。

Option Explicit
Sub LoadData()
Dim sourcePath As String
Dim sourceWorkbook As Workbook
Dim sourceWorksheet As Worksheet
Dim destinationWorksheet As Worksheet
Dim lastSourceRow As Long
Dim lastDestinationRow As Long
'Application.ScreenUpdating = False '==>Moved after InputBox
Application.DisplayAlerts = False
Set destinationWorksheet = ThisWorkbook.Worksheets("Destination")
If MsgBox("Choose the file to retrive the data?", vbYesNo, "Choose Source") = vbYes Then
sourcePath = Application.GetOpenFilename(, , "Browse for Workbook")
If sourcePath <> "False" Then
destinationWorksheet.Range("A2") = sourcePath
Set sourceWorkbook = Workbooks.Open(sourcePath)
On Error Resume Next
sourceWorksheet = Application.InputBox(prompt:="Select any cell inside the target sheet:", Type:=8).Worksheet
On Error GoTo 0
Application.ScreenUpdating = False
lastSourceRow = sourceWorksheet.Cells(Rows.Count, "C").End(xlUp).Row
lastDestinationRow = destinationWorksheet.Cells(destinationWorksheet.Rows.Count, "F").End(xlUp).Offset(0).Row
sourceWorksheet.Range("A:B,D:D").Copy
destinationWorksheet.Range("F1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, skipblanks:=False, Transpose:=False
sourceWorkbook.Close False
destinationWorksheet.Select
End If
Else
Exit Sub
End If
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

myfile = False时,您最终会在屏幕更新关闭的情况下退出潜艇。你要么需要

  1. 确保您的代码始终从头到尾运行,或者
  2. 在执行提前退出之前重新打开应用程序。

If myfile <> False Then
'Your code here
Else
Application.ScreenUpdating = True  '<--- Re-enable before early exit
Exit Sub
End If

如果您需要为当前打开的 excel 实例更正此问题,只需运行单行以重新启用屏幕更新

Sub Oof ()
Application.ScreenUpdating = True
End If

最新更新