Question

我需要在工作簿激活事件上运行一些代码。我创建了一个保存代码的模块，并在工作簿激活事件中调用它。

该代码仅需要影响一个称为“费率”的工作表，但是它也会影响该工作簿中的其他工作表。

我需要将代码限制为该特定工作表。

下面的代码，我知道它不是很干净，但是似乎可以正常工作。

Sub Replace()

Dim sht As Worksheet
Dim fndList As Variant
Dim rplcList As Variant
Dim x As Long
Dim LastRow As Integer
Dim myuniquevalue As String
Dim nextvalue As String

myuniquevalue = Sheets("Rates").Cells(2, 1).Value & Sheets("Rates").Cells(2, 2).Value

Range(Cells(2, 6), Cells(2, 12)).Value = Range(Cells(3, 6), Cells(3, 12)).Value

LastRow = Worksheets("Rates").Cells(Rows.Count, "A").End(xlUp).Row

For i = 2 To LastRow
    nextvalue = Worksheets("Rates").Cells(i, 1).Value &  Worksheets("Rates").Cells(i, 2).Value

    If myuniquevalue <> nextvalue Then
        myuniquevalue = nextvalue
        Range(Cells(i, 6), Cells(i, 12)).Value = Range(Cells(i + 1, 6), Cells(i + 1, 12)).Value
    End If
    LastRow = Sheets("Rates").Cells(Rows.Count, "A").End(xlUp).Row

Next i

LastRow = Worksheets("Rates").Cells(Rows.Count, "A").End(xlUp).Row

myuniquevalue = Worksheets("Rates").Cells(LastRow, 1).Value &   Worksheets("Rates").Cells(LastRow, 2).Value & Worksheets("Rates").Cells(LastRow, 3).Value
Range(Cells(LastRow, 10), Cells(LastRow, 12)).Value = Range(Cells(LastRow - 1, 10), Cells(LastRow - 1, 12)).Value

 For i = LastRow To 2 Step -1
     nextvalue = Worksheets("Rates").Cells(i, 1).Value & Worksheets("Rates").Cells(i, 2).Value & Worksheets("Rates").Cells(i, 3).Value

    If myuniquevalue <> nextvalue Then
        myuniquevalue = nextvalue

        Range(Cells(i, 10), Cells(i, 12)).Value = Range(Cells(i - 1, 10), Cells(i - 1, 12)).Value

     End If

 Next i

fndList = Array("(6 - 12)", "(13 - 24)", "(25 - 36)", "(37 - 61)")
rplcList = Array("12", "24", "36", "48")

Set sht = Worksheets("Rates")
For x = 0 To UBound(fndList)

  'For Each sht In ActiveWorkbook.Worksheets
    sht.Cells.Replace What:=fndList(x), Replacement:=rplcList(x), _
    LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
    SearchFormat:=False, ReplaceFormat:=False

Next x

End Sub

Answer 1

将Set sht = Worksheets("Rates")移动到代码的开头。然后，您可以使用sht仅访问"Rates"工作表的对象，而不会影响工作簿中的其他工作表。

Sub Replace()

Dim sht As Worksheet
Dim fndList As Variant
Dim rplcList As Variant
Dim x As Long
Dim LastRow As Integer
Dim myuniquevalue As String
Dim nextvalue As String

Set sht = Worksheets("Rates")

myuniquevalue = sht.Cells(2, 1).Value & sht.Cells(2, 2).Value

sht.Range(sht.Cells(2, 6), sht.Cells(2, 12)).Value = sht.Range(sht.Cells(3, 6), sht.Cells(3, 12)).Value    

LastRow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row

For i = 2 To LastRow
nextvalue = sht.Cells(i, 1).Value & sht.Cells(i, 2).Value

If myuniquevalue <> nextvalue Then
    myuniquevalue = nextvalue
    sht.Range(sht.Cells(i, 6), sht.Cells(i, 12)).Value = sht.Range(sht.Cells(i + 1, 6), sht.Cells(i + 1, 12)).Value
End If
LastRow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row

Next i

LastRow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row

myuniquevalue = sht.Cells(LastRow, 1).Value & sht.Cells(LastRow, 2).Value & sht.Cells(LastRow, 3).Value
sht.Range(sht.Cells(LastRow, 10), sht.Cells(LastRow, 12)).Value = sht.Range(sht.Cells(LastRow - 1, 10), sht.Cells(LastRow - 1, 12)).Value

 For i = LastRow To 2 Step -1
 nextvalue = sht.Cells(i, 1).Value & sht.Cells(i, 2).Value & sht.Cells(i, 3).Value

 If myuniquevalue <> nextvalue Then
    myuniquevalue = nextvalue

   sht.Range(sht.Cells(i, 10), sht.Cells(i, 12)).Value = sht.Range(sht.Cells(i - 1, 10), sht.Cells(i - 1, 12)).Value

 End If

 Next i

fndList = Array("(6 - 12)", "(13 - 24)", "(25 - 36)", "(37 - 61)")
rplcList = Array("12", "24", "36", "48")

For x = 0 To UBound(fndList)

  'For Each sht In ActiveWorkbook.Worksheets
    sht.Cells.Replace What:=fndList(x), Replacement:=rplcList(x), _
    LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
    SearchFormat:=False, ReplaceFormat:=False

Next x

End Sub

将代码限制为激活工作簿上的一个工作表

1 个答案: