在同一工作表的多个表上应用Excel中的动态格式

我使用Excel文档跟踪加密货币，在同一张表上有多个表。我正在寻找VBA代码，它将根据另一个单元格中的输入格式化单元格

目前我正在使用下面的代码基于另一个单元格进行格式化。我正在努力实现的示例：

代码：

Private子工作表\u更改（ByVal目标作为范围）
有目标
如果.Count=1，则
如果.Column=1，则
如果。值为“BTC”，则
.Offset（，1）.NumberFormat=“0.00000000”和“”以及.Value和“”
其他的
.Offset（，1）.NumberFormat=“”&ChrW（&HE3F）&“0.00000000”
如果结束
如果结束
如果结束
以
端接头

这在一张纸上非常有效

我要找的是对同一张表上的多个表使用这种代码，这些表具有不同的偏移量，“定义”列等等

例如，在表1中，货币在A列中输入，格式化单元格在B列中。在表2中，输入列为C，结果在E和F中，以此类推

上面的代码可以在一张纸上的不同表格中使用吗

---

非常感谢您的见解

由于它与表绑定，并且您不能有重复的表名，因此您可以将其放置在此工作簿中，并按如下方式开始：

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

。。。它可以在每一张纸上工作

..如果只需要在一张表中，则在特定的表中类似：

Private Sub Worksheet_Change(ByVal Target As Range)

…然后：

    Dim lObj As ListObject, cl As Long, ofs As Long, rsz As Long, fc As Long
    With Target
        If .Count = 1 Then
            Set lObj = .ListObject
            If Not lObj Is Nothing Then
                fc = lObj.Range.Cells(1).Column - 1
                Select Case lObj
                    Case "Table1"
                        cl = 1 + fc 'Starting column
                        ofs = 1 'Offset
                        rsz = 1 'Resize(number of columns)
                    Case "Table2"
                        cl = 3 + fc 'Starting column
                        ofs = 2 'Offset
                        rsz = 2 'Resize(number of columns)
                    'Case "Table3"
                    '    cl = 4 + fc 'Starting column
                    '    ofs = 7 'Offset
                    '    rsz = 1 'Resize(number of columns)
                End Select

                If .Column = cl Then

                    Select Case .Value
                        Case "BTC"
                            .Offset(, ofs).Resize(, rsz).NumberFormat = """" & ChrW(&HE3F) & """" & "0.00000000"
                        Case "EUR"
                            .Offset(, ofs).Resize(, rsz).NumberFormat = "0.00" & """" & ChrW(8364) & """"
                        Case Else
                            .Offset(, ofs).Resize(, rsz).NumberFormat = "0.00000000" & """ " & .Value & """"
                    End Select
                End If
            End If
        End If
    End With
End Sub

---

您的表是否被格式化为实际的表（Listobjects）？是的，我想是的，正如我在其他函数中提到的命名表。谢谢-它可以工作！但在得到正确结果的同时，我也得到了一个错误：我还想在货币表达式中添加另一种货币，它具有特殊属性-我们有BTC和“else”。我想加上欧元——因此，如果在列中输入欧元，结果是0,00欧元。我试着把它添加到IF论证中，但运气不好。谢谢大家!@Kgx添加了一个条件，排除了与非ListObject的交互，这将防止出现一些错误，也可以避免代码的放置。如果这回答了你的问题，请接受。好的，酷-答案被接受-这一切都令人惊讶。再次感谢您的帮助！

    Dim lObj As ListObject, cl As Long, ofs As Long, rsz As Long, fc As Long
    With Target
        If .Count = 1 Then
            Set lObj = .ListObject
            If Not lObj Is Nothing Then
                fc = lObj.Range.Cells(1).Column - 1
                Select Case lObj
                    Case "Table1"
                        cl = 1 + fc 'Starting column
                        ofs = 1 'Offset
                        rsz = 1 'Resize(number of columns)
                    Case "Table2"
                        cl = 3 + fc 'Starting column
                        ofs = 2 'Offset
                        rsz = 2 'Resize(number of columns)
                    'Case "Table3"
                    '    cl = 4 + fc 'Starting column
                    '    ofs = 7 'Offset
                    '    rsz = 1 'Resize(number of columns)
                End Select

                If .Column = cl Then

                    Select Case .Value
                        Case "BTC"
                            .Offset(, ofs).Resize(, rsz).NumberFormat = """" & ChrW(&HE3F) & """" & "0.00000000"
                        Case "EUR"
                            .Offset(, ofs).Resize(, rsz).NumberFormat = "0.00" & """" & ChrW(8364) & """"
                        Case Else
                            .Offset(, ofs).Resize(, rsz).NumberFormat = "0.00000000" & """ " & .Value & """"
                    End Select
                End If
            End If
        End If
    End With
End Sub