Question

我有一个代码可以比较不同工作簿中两个工作表之间的标题，并在主工作簿中复制粘贴数据。

   'lastCol = Worksheets("Dashboard").Cells(3, Columns.Count).End(xlToLeft).Column
   lastCol = 15
   lastrow = Worksheets("Dashboard").Cells(Rows.Count, 1).End(xlUp).Row
   Set cmpRng = Range(Cells(1, 1), Cells(3, lastCol))
   a = cmpRng
   i = Cells(Rows.Count, 1).End(xlUp).Row

   Set Wbk = Workbooks.Open("Z:\RMG\RMG Data Master\Global_HEADCOUNT.xls")
   Worksheets("GLOBAL_HEADCOUNT").Select
   Mastcol = Cells(1, Columns.Count).End(xlToLeft).Column
   j = Cells(Rows.Count, 1).End(xlUp).Row
   Set mastRng = Range(Cells(1, 1), Cells(1, Mastcol))
   b = mastRng

For k = 1 To lastCol
    For n = 1 To Mastcol
        If UCase(a(3, k)) = UCase(b(1, n)) Then
        Windows("Global_HEADCOUNT").Activate
            Worksheets("GLOBAL_HEADCOUNT").Range(Cells(2, n), Cells(j, n)).Copy
            Windows("Dashboard.xlsm").Activate
            Worksheets("Dashboard").Select
            Cells(i + 1, k).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            Exit For
        End If
    Next
Next
Call Wbk.Close(False)

现在问题就是每次文件名更改时，用户必须进入代码并更改它，这可能会导致问题，所以我想避免为他们提供使用对话框选择文件的替代方法

我所知道的：

我对如何实现这一点有一点了解，

'The folder containing the files to be recap'd
Set fd = Application.FileDialog(msoFileDialogFilePicker)
fd.InitialFileName = "G:\Work\" '<----- Change this to where the files are stored.
fd.InitialView = msoFileDialogViewList
'allow multiple file selection
fd.AllowMultiSelect = False
fd.Filters.Add "Excel Files", "*.xls*"
filechosen = fd.Show
'Create a workbook for the recap report
Set Master = ThisWorkbook
If filechosen = -1 Then

但是我使用上面的代码来解决其他问题，我很难将我的代码与它集成...我要求的是一点指导，因为我想要实现的结果有点不同：提前预计

Answer 1

这是我通常用来强制用户选择需要打开的工作簿的代码：

Dim f As Object, fso As Object, flder As Object
Dim myfile As String
Dim wb As Workbook, ws As Worksheet
Set wb = ActiveWorkbook
Set ws = ActiveSheet
Set fso = CreateObject("Scripting.FileSystemObject")
With Application.FileDialog(msoFileDialogFilePicker)
    .Show
    If .SelectedItems.Count = 0 Then
        MsgBox "Cancel Selected"
        End
    End If
    myfile = .SelectedItems(1)
End With
Set Wbk= Workbooks.Open(myfile)

或者，您可以将所有文件位置存储在第一张工作表的单元格中，这样他们只需要使用新文件位置更新电子表格，而不是每次都编辑代码或选择工作簿。

要将其与您的代码集成，它看起来像这样：

'lastCol = Worksheets("Dashboard").Cells(3, Columns.Count).End(xlToLeft).Column
lastCol = 15
lastrow = Worksheets("Dashboard").Cells(Rows.Count, 1).End(xlUp).Row
Set cmpRng = Range(Cells(1, 1), Cells(3, lastCol))
a = cmpRng
i = Cells(Rows.Count, 1).End(xlUp).Row

Dim f As Object, fso As Object, flder As Object
Dim myfile As String
Dim wb As Workbook, ws As Worksheet
Set wb = ActiveWorkbook ' this variable lets us go back to our original workbook
Set ws = ActiveSheet ' this variable lets us go back to our original sheet
Set fso = CreateObject("Scripting.FileSystemObject")
With Application.FileDialog(msoFileDialogFilePicker)
    .Show
    If .SelectedItems.Count = 0 Then
        MsgBox "Cancel Selected"
        End
    End If
    myfile = .SelectedItems(1)
End With
dim wbk as workbook ' use this variable to reference the workbook we're opening
dim ghws as worksheet ' this variable should reference the new sheet that gets opened
Set Wbk= Workbooks.Open(myfile)   
set ghws = activesheet

ghws.Select
Mastcol = Cells(1, Columns.Count).End(xlToLeft).Column
j = Cells(Rows.Count, 1).End(xlUp).Row
Set mastRng = Range(Cells(1, 1), Cells(1, Mastcol))
b = mastRng

For k = 1 To lastCol
    For n = 1 To Mastcol
        If UCase(a(3, k)) = UCase(b(1, n)) Then
        wbk.Activate
            ghws.Range(Cells(2, n), Cells(j, n)).Copy
            wbk.Activate
            Ws.Select
            Cells(i + 1, k).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            Exit For
        End If
    Next
Next
Call Wbk.Close(False)

使用对话框选择文件并进行处理

1 个答案: