Excel VBA - 根据单元格地址获取表的名称

Dav*_* S. 3 excel vba excel-vba

我正在使用Excel,我希望根据单元格地址(ex A3)获取表格的名称,此单元格不会移动.我将如何在Excel的VBA中说明这一点?

我的计划是将代码从我的维护选项卡上的一个表的行复制数据验证到我工作簿的每个选项卡上的单个表(减去我的"TOC"和"数据"选项卡).每个选项卡都是"模板"工作表的副本(减去"TOC","数据"和"模板(维护)"工作表).工作表"data","TEMPLATE"和"TEMPLATE(Maint.)"可能隐藏也可能不隐藏.

我在"Copy_Data_Validations"子代码中的代码如下:

Dim TotalSheets As Integer
Dim p As Integer
Dim iAnswer As VbMsgBoxResult

With Application
    .DisplayAlerts = False
    .ScreenUpdating = False
End With

'
' Move sheet "TOC" to the begining of the workbook.
'
Sheets("TOC").Move Before:=Sheets(1)
'
' Move sheet "data" to be the second sheet in the workbook.
'
Sheets("data").Move Before:=Sheets(2)

iAnswer = MsgBox("You are about to copy data validations!", vbOKCancel + vbExclamation _
+ vbDefaultButton2 + vbMsgBoxSetForeground, "Copying Data Valadations")
For TotalSheets = 1 To Sheets.Count
    For p = 3 To Sheets.Count - 2
'
' If the answer is Yes, then copy data validations from "TEMPLATE (Maint.) to all other.
' sheets minus the "TOC" sheet and the "data" sheet.
'
        If iAnswer = vbYes Then
            If UCase$(Sheets(p).Name) <> "TOC" And UCase$(Sheets(p).Name) <> "data" Then

                ' This chunk of code should copy only the data validations
                ' of "Table1_1" (A4:AO4) from the maintenance tab to all
                ' rows of a single table on each worksheet (minus the
                ' "TOC", "data", & the "TEMPLATE (Maint.)" worksheets.
                ' This is the section of code I am looking for unless
                ' someone has something better they can come up with.

                Selection.PasteSpecial Paste:=xlPasteValidation, _
                Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            End If
'
' If the answer is Cancel, then cancels.
'
        ElseIf iAnswer = vbCancel Then
        ' Add an exit here.
        End If

With Application
    .DisplayAlerts = True
    .ScreenUpdating = True
End With
Run Code Online (Sandbox Code Playgroud)

Pet*_*erT 8

ListObject如果该单元格不是表的一部分,则尝试获取任何单元格的名称将导致错误.

Option Explicit

Function CellInTable(thisCell As Range) As String
    Dim tableName As String
    tableName = ""
    On Error Resume Next
    tableName = thisCell.ListObject.Name
    CellInTable = tableName
End Function
Run Code Online (Sandbox Code Playgroud)

  • 顶部的**[Option Explicit](https://msdn.microsoft.com/en-us/library/y9341s4f.aspx)**声明的奖励积分. (5认同)

Ale*_*ell 5

最初的问题有点模棱两可,因此扩展了答案以解决所有相关用例。

一种可能的替代方法是使用Worksheet Formula下面显示的输入Worksheet Cell(例如$A$3),然后从 Excel VBA 宏中引用它:

清单 1.使用单元格公式获取 Excel工作表 名称

=MID(CELL("filename",A3),FIND("]",CELL("filename",A3))+1,255)
Run Code Online (Sandbox Code Playgroud)

该公式基本上是Worksheet NameWorkbook完整路径中提取的。

或者,您可以在 VBA 中实现此目的,前提是您在 中传递Range引用该单元格的对象Worksheet,如下面的演示示例所示:

清单 2. Test Sub 获取单元格“A3”的Excel工作表表格 名称

Option Explicit

'Cell "A3" under the test
Sub GetWorksheetAndTableName()
    Dim myCell As Range
    Set myCell = Range("$A$3")
    Debug.Print "Worksheet Name: " & GetWorksheetName(myCell)
    Debug.Print "Table Name: " & GetTableName(myCell)
End Sub
Run Code Online (Sandbox Code Playgroud)

清单 3. 获取单元格工作表 名称的函数

'get Worksheet Name from Range object
Function GetWorksheetName(CellRange As Range) As String
    On Error Resume Next
    GetWorksheetName = Split(Split(CellRange.Address(External:=True), "]")(1), "!")(0)
End Function
Run Code Online (Sandbox Code Playgroud)

并且,在最简单的形式中,Worksheet Name可以使用以下语句(替换清单 3 中所示的函数中的那个)获得:

清单 4. 获取Cell/Range 对象的父工作表 名称的替代方法

GetWorksheetName = CellRange.Parent.Name
Run Code Online (Sandbox Code Playgroud)

要获取指定的表名称,Worksheet Cell请参考以下清单 5 中显示的代码片段:

清单 5. 获取工作表单元格的表名

Function GetTableName(CellRange As Range) As String
    If (CellRange.ListObject Is Nothing) Then
        GetTableName = ""
    Else
        GetTableName = CellRange.ListObject.Name
    End If
End Function
Run Code Online (Sandbox Code Playgroud)

希望这可能会有所帮助。