Question

我在2个不同的工作表上有2个表，我需要由VBA代码控制。此代码的目的是根据切片器选择调整大小并格式化这些表。

当我一次运行每个代码时，代码可以正常工作。但是，当我尝试同时运行它们时，我收到一条错误消息：＆＃34;选择Range类的方法失败＆＃34;，因为我认为这是尝试在两个不同的范围上运行VBA代码。

以下是我的一个表格的代码：

Private Sub Worksheet_Calculate()
Application.ScreenUpdating = False
Dim ws As Worksheet
Dim ob As ListObject
Dim Lrow1 As Long
Dim rngBottomRowStart As Range
Dim rngBottomRowEnd As Range
Dim rngDataUpperLeftCell As Range

Set ws = ActiveWorkbook.Worksheets("Slide 1")
Set ob = ws.ListObjects("Table6")

Set rngDataUpperLeftCell = Sheet18.Range("A19")
With rngDataUpperLeftCell
    Set rngBottomRowStart = Sheet18.Cells(.End(xlDown).Row, .Column)
    Set rngBottomRowEnd = Sheet18.Cells(rngBottomRowStart.Row, .End(xlToRight).Column)
End With

Sheet18.Range(rngBottomRowStart, rngBottomRowEnd).Borders.LineStyle = xlNone
Sheet18.Range(rngBottomRowStart, rngBottomRowEnd).Font.Bold = False

Set ws = ActiveWorkbook.Worksheets("Slide 1")
Set ob = ws.ListObjects("Table6")

With Sheets("Slide 1")
    Lrow1 = .Cells(.Rows.Count, "G").End(xlUp).Row
    Do Until .Cells(Lrow1, "A").Value = "Region Total"
        Lrow1 = Lrow1 - 1
    Loop

End With

ob.Resize ob.Range.Resize(Lrow1 + 1 - ob.Range.Row)

Set rngDataUpperLeftCell = Sheet18.Range("A19")
With rngDataUpperLeftCell
    Set rngBottomRowStart = Sheet18.Cells(.End(xlDown).Row, .Column)
    Set rngBottomRowEnd = Sheet18.Cells(rngBottomRowStart.Row, .End(xlToRight).Column)
End With

Sheet18.Range(rngBottomRowStart, rngBottomRowEnd).Select
With Selection
    With .Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
End With
End With

Sheet18.Range(rngBottomRowStart, rngBottomRowEnd).Font.Bold = True
Range("A19").Select


Application.ScreenUpdating = True
End Sub

和我的第二张桌子的代码：

Private Sub Worksheet_Calculate()
Application.ScreenUpdating = False
Dim ws As Worksheet
Dim ob As ListObject
Dim Lrow1 As Long
Dim rngBottomRowStart As Range
Dim rngBottomRowEnd As Range
Dim rngDataUpperLeftCell As Range

Set ws = ActiveWorkbook.Worksheets("Slide 4 Test")
Set ob = ws.ListObjects("Table58")

Set rngDataUpperLeftCell = Sheet19.Range("A10")
With rngDataUpperLeftCell
    Set rngBottomRowStart = Sheet19.Cells(.End(xlDown).Row, .Column)
    Set rngBottomRowEnd = Sheet19.Cells(rngBottomRowStart.Row, .End(xlToRight).Column)
End With

Sheet19.Range(rngBottomRowStart, rngBottomRowEnd).Borders.LineStyle = xlNone
Sheet19.Range(rngBottomRowStart, rngBottomRowEnd).Font.Bold = False

Set ws = ActiveWorkbook.Worksheets("Slide 4 Test")
Set ob = ws.ListObjects("Table58")

With Sheets("Slide 4 Test")
    Lrow1 = .Cells(.Rows.Count, "H").End(xlUp).Row
    Do Until .Cells(Lrow1, "A").Value = "Region Total"
        Lrow1 = Lrow1 - 1
    Loop

End With

ob.Resize ob.Range.Resize(Lrow1 + 1 - ob.Range.Row)

Set rngDataUpperLeftCell = Sheet19.Range("A10")
With rngDataUpperLeftCell
    Set rngBottomRowStart = Sheet19.Cells(.End(xlDown).Row, .Column)
    Set rngBottomRowEnd = Sheet19.Cells(rngBottomRowStart.Row, .End(xlToRight).Column)
End With

Sheet19.Range(rngBottomRowStart, rngBottomRowEnd).Select
With Selection
    With .Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
End With
End With

Sheet19.Range(rngBottomRowStart, rngBottomRowEnd).Font.Bold = True
Range("A10").Select
Application.ScreenUpdating = True
End Sub

如何合并此代码，以便在不出错的情况下运行不同的工作表？

在2个不同的工作表上同时运行Worksheet_Calculate

0 个答案: