Question

我有一个文件，我想在其中定义几个范围，将它们存储在一个数组中，并对该数组内的特定组（或整个数组）应用一些修改。下面代码中的所有内容都可以顺利运行（即使可能存在一些不必要的声明，但这是我的错）;但我想补充一下，在今年前三个月的“精选案例”中，一些代码行允许以某种方式“保护”单元格，几乎如下：

“如果（需要此代码）：双击或在定义的数组的任何给定单元格中按F2（打算在该单元格中插入信息）然后

MsgBox“您无法在此特定单元格上手动添加信息”

结束如果“

之后的想法是创建一些打开插入框的按钮 - 这些框中插入的值随后将在单元格中注册，永远不允许“手动”写入。

如果有人可以帮助我，我将不胜感激！提前谢谢！

Sub Structure4()

Application.Workbooks("Book1").Activate

Dim arr As Variant
arr = Array("A6:C105", "I6:AM105", "AN6:AN105", "AO6:AO105", "AP6:AP105", "AQ6:AQ105", "AR6:AR105", "AS6:AS105", "AT6:AT105", "AU6:AU105", "AV6:AV105", "AW6:AW105", "AX6:AX105", "AY6:AY105", "AZ6:AZ105", "BA6:BA105", "BB6:BB105", "BC6:BG105", "BH6:BH105", "BI6:BL105")

Dim wb As Workbook
Set wb = Application.Workbooks("Book1")

Dim ws As Worksheet
Dim i As Integer

For Each ws In wb.Sheets
    Select Case ws.name
    Case "January", "February", "March"
        With ws
            ws.Select
            For i = 0 To 19
                With .Range(arr(i))
                    .Font.name = "Arial Unicode MS"
                    .Font.Size = 8
                    .HorizontalAlignment = xlCenter
                End With
                Select Case i
                    Case 0, 1, 3, 5, 7, 9, 11, 13, 15, 16, 17
                        .Range(arr(i)).NumberFormat = "0.0;[Red]0.0"
                End Select
            Next
        End With
    End Select
Next ws

End Sub

Answer 1

将以下代码放在工作表代码窗格中：

Option Explicit

Dim rng As Range
Dim val As Variant
Dim arrRng As Range

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Not Intersect(arrRng, Target) Is Nothing Then
        MsgBox "You can't add information manually on this specific cell"
        Cancel = True
    End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(arrRng, Target) Is Nothing Then
        If Target.Address = rng.Address Then
            If Target.Value <> val Then
                MsgBox "You can't add information manually on this specific cell"
                Application.EnableEvents = False
                Target.Value = val
                Application.EnableEvents = True
            End If
        End If
    End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Set arrRng = Range("A6:C105, I6:AM105, AN6:AN105, AO6:AO105, AP6:AP105, AQ6:AQ105, AR6:AR105, AS6:AS105, AT6:AT105, AU6:AU105, AV6:AV105, AW6:AW105, AX6:AX105, AY6:AY105, AZ6:AZ105, BA6:BA105, BB6:BB105, BC6:BG105, BH6:BH105, BI6:BL105")

    If Not Intersect(arrRng, Target) Is Nothing Then
        If Target.Count = 1 Then
            Set rng = Target
            val = Target.Value
        End If
    End If
End Sub

双击单元格时检索消息框

1 个答案: