【问题标题】:VBA Replace multiple ranges with different textVBA用不同的文本替换多个范围
【发布时间】:2021-10-28 07:37:25
【问题描述】:

我对 VBA 代码不是很熟悉,希望有人可以帮助我编写此代码。

我试图用 3 个不同的值替换 3 个不同的范围。

我得到的当前代码似乎只执行第一行,最后两行被忽略

Private Sub CommandButton3_Click()
Range("B2, F1, F3:f5, F20, F22:F24") = "Enter Text Here..."
Range("C2, F2, F21") = "Select 1"
Range("C3:C10, B13:B19, B22:B25, A29:D33,F7:F16, F26:F35").ClearContents
End Sub

任何帮助或指导将不胜感激!提前致谢

这是整个代码;

Private Sub CommandButton1_Click()
    Application.ScreenUpdating = False
    If Me.Range("B56").Value = 0 Then
    Dim xsheet As Worksheet
    Set xsheet = Sheets("Heroes_list")
        
            If xsheet.Name <> "Definitions" And xsheet.Name <> "fx" And xsheet.Name <> "Needs" Then
                xsheet.Range("A2:AC2").Copy
                xIntR = xsheet.UsedRange.Rows.Count
                xsheet.Cells(xIntR + 1, 1).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                MsgBox "Saved Successfully!"
            End If

        Application.ScreenUpdating = True
        
Else
    If Me.Range("B56").Value = 1 Then _
        
    MsgBox "Not allowed, please revise costs, conflicts and all fields are filled correctly."
     End If

        Application.ScreenUpdating = True
 End If

        Application.ScreenUpdating = True
End Sub


    


Private Sub CommandButton2_Click()

Application.DisplayAlerts = False
Worksheets("Heroes_list").Copy '  golly im good
With ActiveWorkbook
    ChDir "C:\Users\Evane\Documents\Calix\Photoshop_excel_imports\"
    .SaveAs Filename:="C:\Users\Evane\Documents\Calix\Photoshop_excel_imports\hero" & ".txt", FileFormat:=xlText, CreateBackup:=False
    .Close False
End With
Application.DisplayAlerts = True
MsgBox "Exported successfully!"

End Sub

Private Sub Worksheet_Calculate()
If Me.Range("B52").Value = 1 Then _
MsgBox "The current effect combination for this PRIMARY ATTACK is invalid,Please ensure that if negative effects are listed, the list starts with atleast 1 negative status effect or that the effect list starts at line 1."
End

If Me.Range("B54").Value = 1 Then _
MsgBox "The current effect combination for this SECONDARY ATTACK is invalid,Please ensure that if negative effects are listed, the list starts with atleast 1 negative status effect or that the effect list starts at line 1."
End


If Me.Range("A49").Value > 1 Then _
MsgBox "Element conflict! The same element cannot be listed under both weakness and resistance!"
End
End Sub

Public Sub PasteasValue()
    Selection.PasteSpecial Paste:=xlPasteValues
End Sub



Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Range("b56") = 1 Then Sheets("Hero_creation").CommandButton1.BackColor = RGB(255, 0, 0) 'Red!
If Range("b56") = 1 Then Sheets("Hero_creation").CommandButton1.Font.Strikethrough = True  'strikethrough text
If Range("b56") = 0 Then Sheets("Hero_creation").CommandButton1.BackColor = RGB(0, 255, 0) 'Green!
If Range("b56") = 0 Then Sheets("Hero_creation").CommandButton1.Font.Strikethrough = False 'No strik through text
End Sub

'New Code

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.address = "$B$2" Or Target.address = "$F$1" Or Target.address = "$F$20" Or Target.address = "$C$2" Or Target.address = "$F$2" Or Target.address = "$F$3" Or Target.address = "$F$4" Or Target.address = "$F$5" Or Target.address = "$F$21" Or Target.address = "$F$22" Or Target.address = "$F$23" Or Target.address = "$F$24" Or Target.address = "$C$3" Or Target.address = "$C$4" Or Target.address = "$C$5" Or Target.address = "$C$6" Or Target.address = "$C$7" Or Target.address = "$C$8" Or Target.address = "$C$9" Or Target.address = "$C$10" Then
        If Target.Value = "" Then  '  case a cell was emptied
         Let Application.EnableEvents = False
         Let Target.Value = "Enter Text Here..."
         Let Application.EnableEvents = True

        Else  '  case a text was entered
            With Target.Font
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            End With
        End If
    Else
    ' Target is Not a cell to be acted on
    End If
End Sub

Private Sub CommandButton3_Click()
    Range("B2, F1, F3:f5, F20, F22:F24") = "Enter Text Here..."
    Range("C2, F2, F21") = "Select 1"
    Range("C3:C10, B13:B19, B22:B25, A29:D33,F7:F16, F26:F35").ClearContents
    End Sub

【问题讨论】:

  • 当我测试它时它工作得很好。工作簿中还有其他代码吗?
  • 还有一些其他的东西,你认为会有冲突吗?
  • 对我来说就是这样。您是否在仅包含该代码的工作簿中尝试过它?如果是这样,我很确定你会看到它正在按照你说的做。
  • 刚刚在另一个工作簿中尝试过,没错。不知道我可能会与之发生冲突。感谢您的帮助
  • 我几乎可以保证,如果您尝试逐步逐行(根据@RaymondWu)通过代码,同时保持密切关注每一行代码的影响。这是来自 VBA 大师 Chip Pearson 的一些 excellent advice about debugging VBA 的链接。 (??????我还建议收藏他的list of VBA solutions 以供将来参考。)

标签: excel vba


【解决方案1】:

在您的Worksheet_Calculate 事件中,您在Ends 中缺少If,它以End 语句结尾,这会立即停止整个过程

我还在Then 之后删除了_

完整代码如下:

Private Sub Worksheet_Calculate()
    If Me.Range("B52").Value = 1 Then
        MsgBox "The current effect combination for this PRIMARY ATTACK is invalid,Please ensure that if negative effects are listed, the list starts with atleast 1 negative status effect or that the effect list starts at line 1."
    End If
    
    If Me.Range("B54").Value = 1 Then
        MsgBox "The current effect combination for this SECONDARY ATTACK is invalid,Please ensure that if negative effects are listed, the list starts with atleast 1 negative status effect or that the effect list starts at line 1."
    End If
        
    If Me.Range("A49").Value > 1 Then
        MsgBox "Element conflict! The same element cannot be listed under both weakness and resistance!"
    End If
End Sub

我假设Worksheet_Calculate 被触发是因为您有来自其他单元格的公式受更改影响,因此如果您不希望触发它,请操作Application.EnableEvents 属性:

Private Sub CommandButton3_Click()
    Application.EnableEvents = False
    Range("B2, F1, F3:f5, F20, F22:F24") = "Enter Text Here..."
    Range("C2, F2, F21") = "Select 1"
    Range("C3:C10, B13:B19, B22:B25, A29:D33,F7:F16, F26:F35").ClearContents
    Application.EnableEvents = True
End Sub

【讨论】:

  • 我打赌雷蒙德通过代码通过stepping 弄清楚了这一点。 ?
  • @ashleedawg 我很幸运,没有任何风险!停在End 的代码立刻让我很好奇,这就是我注意到“错别字”的地方
  • 传奇@RaymondWu!非常感谢您的帮助,也感谢其他所有人!
猜你喜欢
  • 1970-01-01
  • 2021-01-09
  • 2018-11-25
  • 1970-01-01
  • 1970-01-01
  • 1970-01-01
  • 2021-02-15
  • 1970-01-01
  • 2013-03-31
相关资源
最近更新 更多