VBA - 更改单元格公式

时间:2018-04-05 10:37:07

标签: excel vba

我正在尝试创建一个代码,其中我将对所选范围内的特定工作表的所有引用更改为新选择的工作表 - 即不同工作表中的相同相对单元格引用。要更换的纸张参考(原始纸张)和替换纸张参考(新纸张)由用户通过用户表单中的组合框选择。代码工作正常,只要两个工作表名称在是否需要单引号方面相当,即OSheet =“Sheet1”和NSheet =“Sheet2”或OSheet =“Sheet - 1”和NSheet =“Sheet - 2" 。但是,当他们对单引号有不同的要求时,我会遇到问题。 OSheet =“Sheet1”和NSheet =“Sheet - 2”,因为公式中的工作表参考将是Sheet1! vs'Sheet - 2!'。

您是否有任何关于如何解决此问题并将此代码标准化的提示?

Private Sub UserForm_Initialize()

Me.OriginalSheet.Clear
Me.NewSheet.Clear

For i = 1 To Sheets.Count
    With Me.OriginalSheet
        .AddItem Sheets(i).Name
    End With
    With Me.NewSheet
        .AddItem Sheets(i).Name
    End With
Next i

With Me.OriginalSheet
    .ListIndex = 0
End With

With Me.NewSheet
    .ListIndex = 0
End With

End Sub  

Private Sub CommandButton1_Click()
Dim OriginalSheet, NewSheet As String
Dim xRange As Range
Set xRange = Selection

OSheet = Me.OriginalSheet.Value
NSheet = Me.NewSheet.Value

    With xRange
        .Replace What:=OSheet, Replacement:=NSheet, LookAt:=xlPart, _
                 SearchOrder:=xlByRows, MatchCase:=False, _
                 SearchFormat:=False, ReplaceFormat:=False
    End With

Unload Me

End Sub

2 个答案:

答案 0 :(得分:0)

更新: 要测试多个可能的角色,您可以使用Regular Expression匹配。下面的代码使用后期绑定来创建一个正则表达式对象,并指定一个匹配的模式,如果测试的字符串包含任何不是字母,数字,下划线或句点的字符,或者以数字开头:

Dim objRegExp As Object
Set objRegExp = CreateObject("VBScript.RegExp")
objRegExp.Pattern = "[^a-zA-Z0-9_.]|^\d"

然后,您可以使用RegExp.Test函数作为IIF函数的Expression参数,如下所示:

Osheet = IIf(objRegExp.Test(Me.OriginalSheet.Value), "'" & Me.OriginalSheet.Value & "'", Me.OriginalSheet.Value)
NSheet = IIf(objRegExp.Test(Me.NewSheet.Value), "'" & Me.NewSheet.Value & "'", Me.NewSheet.Value)

答案 1 :(得分:0)

经过一番思考后我找到了一个不错的解决方案,但忘记发布了。话虽如此,beldin0的答案就像一个魅力。为有兴趣的人发布替代解决方案。

Private Sub CommandButton1_Click()
Dim OSheet As String, NSheet As String
Dim xRange As Range
Set xRange = Selection

n = 0
k = 0

For i = 32 To 126
    Select Case i
    Case 46, 48 To 57, 65 To 90, 95, 97 To 122
        'Do nothing
    Case Else
        If InStr(1, Me.OriginalSheet.Value, Chr(i)) <> 0 Then n = n + 1

        If InStr(1, Me.NewSheet.Value, Chr(i)) <> 0 Then k = k + 1

    End Select
Next i

If IsNumeric(Left(Me.OriginalSheet.Value, 1)) Then n = n + 1
If IsNumeric(Left(Me.NewSheet.Value, 1)) Then k = k + 1

If n > 0 Then OSheet = "'" & Me.OriginalSheet.Value & "'" & "!" Else OSheet = Me.OriginalSheet.Value & "!"
If k > 0 Then NSheet = "'" & Me.NewSheet.Value & "'" & "!" Else NSheet = Me.NewSheet.Value & "!"

    With xRange
        .Replace What:=OSheet, Replacement:=NSheet, LookAt:=xlPart, _
                 SearchOrder:=xlByRows, MatchCase:=False, _
                 SearchFormat:=False, ReplaceFormat:=False
    End With

Unload Me

Set xRange = Nothing

End Sub