Question

我将脚本复制到命令按钮（甚至尝试重新输入）。之前的脚本工作正常，但也可以通过其他几个不相关的步骤。

我想设置一个宏来运行命令按钮，以便只更新表中的数据。但由于某种原因，我收到编译错误：需要变量 - 无法分配给此表达式。错误发生在：ReportWbk.Sheets("Sheet1").Range(Cells(2, shtc), Cells(1000, shtc)).Copy（第28行）

该文件的目标是确定与需要提取，复制然后粘贴的数据相关的列。这是脚本。我错过了什么？

Option Explicit

Dim ReportWbk As Workbook 'workbook with report data
Dim Report As String 'name of file with report data
Dim SrchRng As Range
Dim shtc As Integer, ttl As Integer

Private Sub CommandButton1_Click()

On Error goto here

    Application.FileDialog(msoFileDialogFilePicker).Show
    Report = Application.FileDialog(msoFileDialogFilePicker).SelectedItems(1)
    Set ReportWbk = Workbooks.Open(Report)
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False

    shtc = 1
    While ReportWbk.Sheets("Sheet1").Cells(1, shtc) <> "Name"
        shtc = shtc + 1
    Wend

    ttl = 1
    While ReportWbk.Sheets("Sheet1").Cells(1, ttl) <> "Val.in rep.cur."
        ttl = ttl + 1
    Wend

    ThisWorkbook.Sheets("Sheet2").Range("a2:b1000").ClearContents
    ReportWbk.Sheets("Sheet1").Activate
    ReportWbk.Sheets("Sheet1").Range(Cells(2, shtc), Cells(1000, shtc)).Copy
    ThisWorkbook.Sheets("Sheet2").Activate
    ThisWorkbook.Sheets("Sheet2").Cells(2, 1).Select: Selection.PasteSpecial xlPasteValues
    ThisWorkbook.Sheets("Sheet2").Cells(2, 1).Select

    ReportWbk.Sheets("Sheet1").Activate
    ReportWbk.Sheets("Sheet1").Range(Cells(2, ttl), Cells(1000, ttl)).Copy
    ThisWorkbook.Sheets("Sheet2").Activate
    ThisWorkbook.Sheets("Sheet2").Cells(2, 2).Select: Selection.PasteSpecial xlPasteValues
    ThisWorkbook.Sheets("Sheet2").Cells(2, 2).Select

    ReportWbk.Close (False)

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True


    With CommandButton1
        .AutoSize = False
        .AutoSize = True
        .Height = 40
        .Left = 435
        .Width = 200
        .Top = 12
    End With


Exit Sub

here:
    MsgBox ("Select the correct file!")
    ReportWbk.Close (False)
Exit Sub

End Sub

Answer 1

一点点重构：

Option Explicit

Private Sub CommandButton1_Click()

    Const NUM_ROWS As Long = 1000 'number of rows to copy
    Dim shtRpt As Worksheet, sht2 As Worksheet, shtc As Long, ttl As Long, Report
    Dim ReportWbk As Workbook

    Application.FileDialog(msoFileDialogFilePicker).Show
    Report = Application.FileDialog(msoFileDialogFilePicker).SelectedItems(1)

    Set ReportWbk = Workbooks.Open(Report)
    Set shtRpt = ReportWbk.Sheets("Sheet1")
    Set sht2 = ThisWorkbook.Sheets("Sheet2")

    'find the header columns
    shtc = GetColumn(shtRpt.Rows(1), "Name")
    ttl = GetColumn(shtRpt.Rows(1), "Val.in rep.cur.")

    'missing columns ?
    If shtc = 0 Or ttl = 0 Then
        MsgBox "Select the correct file!", vbExclamation
        ReportWbk.Close False
        Exit Sub
    End If

    sht2.Range("A2").Resize(NUM_ROWS, 1).Value = _
                   shtRpt.Cells(2, shtc).Resize(NUM_ROWS, 1).Value
    sht2.Range("B2").Resize(NUM_ROWS, 1).Value = _
                   shtRpt.Cells(2, ttl).Resize(NUM_ROWS, 1).Value


    ReportWbk.Close (False)

    With CommandButton1
        .AutoSize = False
        .AutoSize = True
        .Height = 40
        .Left = 435
        .Width = 200
        .Top = 12
    End With

End Sub

'get the column number for specified content
'  return zero if not found
Function GetColumn(rng As Range, hdr) As Long
    Dim f As Range, rv As Long
    rv = 0
    Set f = rng.Find(hdr, , xlValues, xlWhole)
    If Not f Is Nothing Then rv = f.Column
    GetColumn = rv
End Function

尝试复制数据时出现应用程序定义或对象定义的错误

1 个答案: