时间戳

首页 > 解决方案 > Excel VBA 中需要的对象

excel - Excel VBA 中需要的对象

问题描述

我试图让用户输入工作表名称并根据输入我希望将选定的单元格值从一个工作表复制到另一工作表到新行。

这是一个基本的excel功能系统

Set nextCellInColumn = Worksheets("Summary").Cells(Rows.Count, 4).End(xlUp).Offset(1, 0)
strName = Application.InputBox("Please enter")
nextCellInColumn.Value = Worksheets.Application.InputBox("Please enter").Range("I5").Value
Worksheets.Application.InputBox("Please enter").Range("I5").Copy Worksheets("Summary").Range("D6")

标签： excelvba

解决方案

您需要测试用户输入的工作表名称是否存在，否则复制将失败。此外，如果用户按下Cancel按钮，InputBox将返回一个 boolean False。您需要检查并退出，否则您的代码也会失败。

Option Explicit

Public Sub Test()
    Dim wsSummary As Worksheet
    Set wsSummary = ThisWorkbook.Worksheets("Summary")

    Dim NextCellInColumn As Range
    Set NextCellInColumn = wsSummary.Cells(wsSummary.Rows.Count, 4).End(xlUp).Offset(1, 0)

    Dim strName As Variant 'if user presses cancel it will return a boolean false
    strName = Application.InputBox("Please enter")

    If VarType(strName) = vbBoolean And strName = False Then Exit Sub 'user pressed cancel so exit

    If WorksheetExists(strName) Then
        NextCellInColumn.Value = ThisWorkbook.Worksheets(strName).Range("I5").Value
        ThisWorkbook.Worksheets(strName).Range("I5").Copy wsSummary.Range("D6")
    Else
        MsgBox "Worksheet '" & strName & "' not found.", vbCritical
    End If
End Sub

'check if a worksheet exists
Public Function WorksheetExists(ByVal WorksheetName As String, Optional ByVal wb As Workbook) As Boolean
    If wb Is Nothing Then Set wb = ThisWorkbook 'default to thisworkbook

    Dim ws As Worksheet
    On Error Resume Next
    Set ws = wb.Worksheets(WorksheetName)
    On Error GoTo 0

    WorksheetExists = Not ws Is Nothing
End Function

推荐阅读