用于在更改工作表名称时更改vba的Dyanmic VBA代码

时间:2016-07-21 16:57:59

标签: excel vba excel-vba excel-formula

我有一个vba代码,用于指定要查看的特定工作表名称,例如工作表2,

但是,如果有人忘记将工作表名称更改为sheet2,我可以添加一段动态代码来自动更改为其命名工作表名称的vba代码吗?例如左边的第二张纸。

代码模块1:

Sub Calculation()
 Range("P2:P800").Select
Application.CutCopyMode = False
Selection.ClearContents

Dim dict1 As Object
Dim c1 As Variant, k As Variant
Dim currWS As Worksheet
Dim i As Double, lastRow As Double, tot As Double
Dim number1 As Double, number2 As Double, firstRow As Double

Set dict1 = CreateObject("Scripting.Dictionary")
Set currWS = ThisWorkbook.Sheets("Trade data")

'get last row withh data in Column A
lastRow = currWS.Cells(Rows.Count, "M").End(xlUp).Row

'put unique numbers in Column A in dict1
c1 = Range("M2:V" & lastRow)
For i = 1 To UBound(c1, 1)
    If c1(i, 1) <> "" Then
        'make combination with first 4 characters
      dict1(Left(c1(i, 1), 4) & "," & Left(c1(i, 8), 4) & "," & Left(c1(i,
    6), 10) & "," & Left(c1(i, 10), 7)) = 1
    End If
Next i

'loop through all the numbers in column A
For Each k In dict1.keys
    number1 = Split(k, ",")(0)
    number2 = Split(k, ",")(1)
    tot = 0
    firstRow = 0

    For i = 2 To lastRow
        If k = Left(currWS.Range("M" & i).Value, 4) & "," & 
        Left(currWS.Range("T" & i).Value, 4) & "," & currWS.Range("R" &
     i).Value & "," & (currWS.Range("O" & i).Value) Then
            If firstRow = 0 Then
                firstRow = i
            End If
            tot = tot + currWS.Range("W" & i).Value
        End If
    Next i
    currWS.Range("P" & firstRow) = tot
Next k

Call Consolidate
Call SingleTradeMove
End Sub

模块2代码:     Sub SingleTradeMove()

 Dim wsTD As Worksheet
 Set wsTD = Worksheets("Trade data")

 Sheets("UnMatching").Range("A2:AK600").ClearContents

 With wsTD

 lastRow = .Range("A" & .Rows.Count).End(xlUp).Row

 For i = 2 To lastRow


If Left(.Cells(i, "M"), 4) <> Left(.Cells(i, "T"), 4) _
    Or .Cells(i, "O") <> .Cells(i, "V") _
    Or .Cells(i, "R") <> .Cells(i, "Y") Then

       .Cells(i, "J").EntireRow.Copy _
           Destination:=Sheets("UnMatching").Range("A" &   Rows.Count).End(xlUp).Offset(1)

     End If

 Next i

End With

End Sub

1 个答案:

答案 0 :(得分:1)

建立ian0411的答案,因为我无法发表评论。您也可以将此名称更改为简写。我总是将我的名称更改为CN,然后使用缩写或简短的名称来输入。在示例中,excel中的工作表名称为BlueMoon。所以我在VBA中使用了CNBM。这提供了对工作表的引用,并且可以更改excel一侧的工作表名称,而不会影响您的代码。要更改名称,请在属性框中单击要命名的工作表。然后在下面更改(名称)选项。

Image of VBA properties