Question

源列包含每个单元格中的字符串。有4000多个细胞。这些需要复制并粘贴到活动（调用宏）工作簿的工作表中。用户应使用搜索/浏览弹出框选择源工作簿。

下面的代码做了一些接近我预期目标但是...你看到的目录是静态的，这是不可接受的。用户手动选择源文件时应具有最大的灵活性。此外，我希望每次重命名/移位文件夹/文件时都防止文件路径过时。有些东西告诉我应该使用“Application.GetOpenFilename（）”。但是如何正确实现呢？

对VBA缺乏经验，我尝试修改此宏失败了。所以我要求你就此事提供帮助/建议。同样，下面的代码运行良好，但它不够灵活，不够实用。多谢你们！：）

编辑：问题解决了！查看最终的工作代码。希望它对程序员有一些用处。：）

'MACRO将读取外部EXCEL文件从哪个工作中被提取到用户形式 Sub ReadDataFromCloseFile（）

        'IN CASE OF ERROR SEND TO ERROR FUNCTION
            On Error GoTo ErrHandler

        'PREVENT OPENED EXCEL SOURCE FILE FROM SHOWING TO USER
            Application.ScreenUpdating = False

        'OPEN SOURCE EXCEL WORKBOOK IN "READ ONLY MODE"
            Dim SrcName As String
            Dim src As Workbook
            SrcName = Application.GetOpenFilename()
            Set src = Workbooks.Open(SrcName, True, True)

        'GET THE TOTAL ROWS FROM THE SOURCE WORKBOOK
            Dim iTotalRows As Integer
            iTotalRows = src.Worksheets("PROJECT LIST").Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row).Rows.Count

        'COPY DATA FROM SOURCE WORKBOOK  -> DESTINATION WORKBOOK
            Dim iCnt As Integer     '(COUNTER)
            For iCnt = 1 To iTotalRows
                Worksheets("Test_File_8").Range("B" & (iCnt + 1)).Formula = src.Worksheets("PROJECT LIST").Range("A" & (iCnt + 1)).Formula
            Next iCnt

        'CLOSE THE SOURCE WORKBOOK FILE
            src.Close False             'FALSE = DONT SAVE THE SOURCE FILE
            Set src = Nothing           'FLUSH DATA

        'ERROR FUNCTION

ErrHandler： Application.EnableEvents = True Application.ScreenUpdating = True 结束子

Answer 1

请参阅下面的更改。我添加了两个变量X和strSrc。 X是用于遍历.SelectedItems的变体，而strSrc是最终保存路径的字符串。

    Sub ReadDataFromCloseFile()

    'Set variable to hold workbook path and workbook path string
       Dim X as Variant
       Dim strSrc as String

       With Application.FileDialog(msoFileDialogFilePicker)
          .InitialFileName = "" ' You can provide a base path here
          .Title = "Select file."
          .AllowMultiSelect = False
          If .Show = -1 Then
              For Each X In .SelectedItems
                  strSrc = X
                  Exit For
              Next X
          End If
       End With

    'IN CASE OF ERROR SEND TO ERROR FUNCTION
        'On Error GoTo ErrHandler

    'PREVENT OPENED EXCEL SOURCE FILE FROM SHOWING TO USER
        Application.ScreenUpdating = False

    'OPEN SOURCE EXCEL WORKBOOK IN "READ ONLY MODE"
        Dim src As Workbook
        Set src = Workbooks.Open(strSrc, True, True)

    'GET THE TOTAL ROWS FROM THE SOURCE WORKBOOK
        Dim iTotalRows As Integer
        iTotalRows = src.Worksheets("PROJECT LIST").Range("A1:A" & src.Worksheets("PROJECT LIST").Cells(Rows.Count, "A").End(xlUp).Row).Rows.Count

    'COPY DATA FROM SOURCE WORKBOOK  -> DESTINATION WORKBOOK
            Dim iCnt As Integer     '(COUNTER)
            For iCnt = 1 To iTotalRows
                src.Worksheets("Test_File_8").Range("B" & (iCnt + 1)).Formula = src.Worksheets("PROJECT LIST").Range("A" & (iCnt + 1)).Formula
            Next iCnt

    'CLOSE THE SOURCE WORKBOOK FILE
        src.Close False             'FALSE = DONT SAVE THE SOURCE FILE
        Set src = Nothing           'FLUSH DATA

    'ERROR FUNCTION
     ErrHandler: Application.EnableEvents = True Application.ScreenUpdating = True End Sub

    'MACRO TO READ-IN EXTERNAL EXCEL FILE FROM WHICH JOB NO.'S ARE EXTRACTED INTO USERFORM

如何将列从用户选择的源工作簿\工作表\列复制到活动目标工作簿\工作表\列？

1 个答案: