脚本运行但不执行任何操作

Question

脚本运行没有错误，但它没有做它应该做的事情，事实上它没有改变文档中的任何内容。我测试了一个零件，测试软件吐出 4 个工作簿，这些工作簿保存在名为位置 1、2、3、4 的文件夹中。然后我在脚本中打开一个模板 "alpha"，该模板使用上一个工作簿中的数据来显示平均值和数据轨迹。然后通过按钮激活宏，它应该粘贴到 alpha 工作簿中的下一个空行。行相隔 6 个单元格，横跨 3 个单元格。

显然我在图片之前需要 10 个代表所以这里是图片 link....在图片中一个测试已经完成，我有一个用于一个测试（行）的宏但我无法得到它重复并粘贴到下一个空白处。如果有更好的方法，请告诉我哈哈。 https://drive.google.com/file/d/0B9n6BtJ4Med8NlVGa2FySzEtMGM/view?usp=sharing

Sub DataTransfer()

 'simplified to 2 workbooks

Dim w As Workbook 'Test_Location 1
Dim Alpha As Workbook 'Template
Dim Emptyrow As Range

    Set w = Workbooks.Open("C:\Users\aholiday\Desktop\FRF_Data_Macro_Insert_Test\location_1.xls")
    Set Alpha = Workbooks("FRF_Data_Sheet_Template.xlsm")
    Set EmptyrowC = Range("C" & Alpha.Sheets("DataInput").UsedRange.Rows.Count + 1)

        w.Sheets("Data").Range("I3:K7").Copy
        With Alpha.Sheets("DataInput")
        EmptyrowC.PasteSpecial Paste:=xlValues, Transpose:=False
        Application.CutCopyMode = True


        End With

  End Sub

我也尝试过做一个 If 语句，但没有找到它。

 Sub DataTransfer()

 Application.ScreenUpdating = False
 Dim w As Workbook 'Test_Location 1
 Dim x As Workbook 'Test_Location 2
 Dim y As Workbook 'Test_Location 3
 Dim z As Workbook 'Test_Location 4
 Dim Alpha As Workbook 'Template
 Dim Emptyrow As Long 'Next Empty Row

Set w = Workbooks.Open("C:\Users\aholiday\Desktop\FRF_Data_Macro_Insert_Test\location_1.xls")
Set x = Workbooks.Open("C:\Users\aholiday\Desktop\FRF_Data_Macro_Insert_Test\location_2.xls")
Set y = Workbooks.Open("C:\Users\aholiday\Desktop\FRF_Data_Macro_Insert_Test\location_3.xls")
Set z = Workbooks.Open("C:\Users\aholiday\Desktop\FRF_Data_Macro_Insert_Test\location_4.xls")
Set Alpha = Workbooks("FRF_Data_Sheet_Template.xlsm")

    If Columns("C").Value = "" Then
        Alpha.Sheets("DataInput").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Value = w.Sheets("Data").Range("I3:K7").Value
        Alpha.Sheets("DataInput").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Value = x.Sheets("Data").Range("I3:K7").Value
        Alpha.Sheets("DataInput").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Value = y.Sheets("Data").Range("I3:K7").Value
        Alpha.Sheets("DataInput").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Value = z.Sheets("Data").Range("I3:K7").Value

        w.Close False
        x.Close False
        y.Close False
        z.Close False
    End If

Application.ScreenUpdating = 真结束子

Answer 1

我做了一些（合理的...？）假设并重写了第一个代码以使用设置的变量并定义各种范围起源于的特定工作簿。

Sub DataTransfer()

    Dim w As Workbook 'Test_Location 1
    Dim x As Workbook 'Test_Location 2
    Dim y As Workbook 'Test_Location 3
    Dim z As Workbook 'Test_Location 4
    Dim Alpha As Workbook 'Template
    Dim EmptyrowC As Range, EmptyrowF As Range, EmptyrowI As Range, EmptyrowL As Range

    Application.ScreenUpdating = False

    Set w = Workbooks.Open("C:\Users\aholiday\Desktop\FRF_Data_Macro_Insert_Test\location_1.xls")
    Set x = Workbooks.Open("C:\Users\aholiday\Desktop\FRF_Data_Macro_Insert_Test\location_2.xls")
    Set y = Workbooks.Open("C:\Users\aholiday\Desktop\FRF_Data_Macro_Insert_Test\location_3.xls")
    Set z = Workbooks.Open("C:\Users\aholiday\Desktop\FRF_Data_Macro_Insert_Test\location_4.xls")
    Set Alpha = Workbooks("FRF_Data_Sheet_Template.xlsm")

    With Alpha.Sheets("DataInput")
        Set EmptyrowC = .Cells(Rows.Count, "C").End(xlUp).Offset(1, 0)
        Set EmptyrowF = .Cells(Rows.Count, "F").End(xlUp).Offset(1, 0)
        Set EmptyrowI = .Cells(Rows.Count, "I").End(xlUp).Offset(1, 0)
        Set EmptyrowL = .Cells(Rows.Count, "L").End(xlUp).Offset(1, 0)

        w.Sheets("Data").Range("I3:K7").Copy Destination:=EmptyrowC
        x.Sheets("Data").Range("I3:K7").Copy Destination:=EmptyrowF
        y.Sheets("Data").Range("I3:K7").Copy Destination:=EmptyrowI
        z.Sheets("Data").Range("I3:K7").Copy Destination:=EmptyrowL

        w.Close False
        x.Close False
        y.Close False
        z.Close False
    End With

    Application.ScreenUpdating = True

End Sub

您是否绝对需要 Range.PasteSpecial method so you get yo started, I've opted for the simpler Range.Copy 方法并不是 100% 清楚的。如果这还不够，那么直接值传输比 Copy、PasteSpecial、Values 更可取。

Answer 2

像这样：

Option Explicit

Sub DataTransfer()

    Const FPATH As String = "C:\Users\aholiday\Desktop\FRF_Data_Macro_Insert_Test\"

    Application.ScreenUpdating = False

    Dim wb As Workbook
    Dim shtAlpha As Worksheet 'Template
    Dim locs, loc
    Dim rngDest As Range

    locs = Array("location_1.xls", "location_2.xls", _
                 "location_3.xls", "location_4.xls")

    Set shtAlpha = Workbooks("FRF_Data_Sheet_Template.xlsm").Sheets("DataInput")

    'set the first data block destination
    Set rngDest = shtAlpha.Cells(Rows.Count, "C").End(xlUp).Offset(1, 0).Resize(5, 3)

    For Each loc In locs

        Set wb = Workbooks.Open(Filename:=FPATH & loc, ReadOnly:=True)

        rngDest.Value = wb.Sheets("Data").Range("I3:K7").Value

        wb.Close False

        Set rngDest = rngDest.Offset(0, 3) 'move over to the right 3 cols

    Next loc

    Application.ScreenUpdating = True

End Sub

我不确定你对 C 列的检查是什么意思，所以我忽略了它...

脚本运行但不执行任何操作

Script Runs but doesn't do anything

excel

vba

runtime-error