EXCEL表格权限、非空格禁止修改的设置

Question

我的采购台账标记黄色部份数据来源为基础信息，有高手能帮忙解决设置问题吗?1.在基础信息表和采购台账内，怎麽分别设置或写VBA能让工作表内已输入数据的空格不能修改，未输入的数据的空格可修改，但是这个表格的数据仍可被采购台账做为数据源引用。2.采购台账现有的VBA如下，我要填加怎样的VBA进去让工作表内已输入数据的空格不能修改，未输入的数据的空格可修改，并且筛选的功能仍可正常使用。Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim arr, i& Dim d As Object On Error Resume Next If Target.Count > 1 Then Exit Sub If Intersect(Target, Range("F3:L2000")) Is Nothing Then Exit Sub arr = Sheets("基础信息").Range("a1").CurrentRegion Set d = CreateObject("Scripting.Dictionary") For i = 2 To UBound(arr) If Not d.exists(arr(i, 1)) Then Set d(arr(i, 1)) = CreateObject("scripting.dictionary") '一级字典嵌套..........中间VBA过多省略 ElseIf Target.Column = 11 Then With Target.Validation .Delete .Add Type:=xlValidateList, Operator:=xlBetween, Formula1:=Join(d(Target.Offset(0, -5).Value)(Target.Offset(0, -4).Value)(Target.Offset(0, -3).Value)(Target.Offset(0, -2).Value)(Target.Offset(0, -1).Value).keys, ",") End With Else With Target.Validation .Delete .Add Type:=xlValidateList, Operator:=xlBetween, Formula1:=Join(d(Target.Offset(0, -6).Value)(Target.Offset(0, -5).Value)(Target.Offset(0, -4).Value)(Target.Offset(0, -3).Value)(Target.Offset(0, -2).Value)(Target.Offset(0, -1).Value).keys, ",") End With End IfEnd Sub3.怎麽设置活页簿可多人共享，但是单个工作表输入资料或是修改资料需要密码或权限。或是可直接在每个工作表内以VBA的方式分别设置?

Answer 1

先回答人第一问题

将你VBA中的：

If Target.Count > 1 Then Exit Sub

这一行删除，替换为以下代码

Dim Rng As Range, Rng1 As Range

For Each Rng In UsedRange

If Rng.Value = "" Then

Set Rng1 = Rng

Exit For

End If

Next

If Rng1 Is Nothing Then Set Rng1 = Range("A" & (UsedRange.Rows.Count + 1))

If Target.Count > 1 Or Target.Value <> "" Then

Rng1.Select

Exit Sub

End If

回答第二个问题共享保护的问题：

新增一个工作表，并命名该工作表为“密码表”，表中数据结构如下：

然后进入VBA，双击thisworkbook对象，写入以下代码：

Private Sub Workbook_BeforeClose(Cancel As Boolean)

Dim Sht As Worksheet, i As Long, ShtPassword As String

For Each Sht In ThisWorkbook.Worksheets

For i = 1 To Sheets("密码表").Range("A100").End(xlUp).Row

If Sheets("密码表").Range("A" & i).Value = Sht.Name Then

ShtPassword = Sheets("密码表").Range("B" & i).Value

Sht.Protect Password:=ShtPassword, DrawingObjects:=True, Contents:=True, Scenarios:=True

End If

Next

Next

Sheets("密码表").Visible = 0

End Sub

Private Sub Workbook_Open()

Dim Sht As Worksheet, i As Long, ShtPassword As String

For Each Sht In ThisWorkbook.Worksheets

For i = 1 To Sheets("密码表").Range("A100").End(xlUp).Row

If Sheets("密码表").Range("A" & i).Value = Sht.Name Then

ShtPassword = Sheets("密码表").Range("B" & i).Value

Sht.Protect Password:=ShtPassword, DrawingObjects:=True, Contents:=True, Scenarios:=True

End If

Next

Next

Sheets("密码表").Visible = 0

End Sub

以上代码的功能是由管理员"密码表"中设置和修改保护密码即可，平时这个表都是被隐藏的，管理员要修改密码可以从VBA界面中把密码表显示出来再修改，也可以再写代码用来为显示和隐藏密码表，这里我就不多写了

EXCEL在每次打开和退出文件时，都会按照“密码表”中设置的密码，对每个工作表进行保护，使用人需要输入和编辑工作时，都要在菜单栏上手动去解除工作表的保护。

当然也可以写个宏命令，在使用人第一次输入或编辑工作表时，弹出一个inputbox窗口，要求其输入保护密码，密码正确就解除当前工作的密码保护

刚刚对第一个问题的代码进行了修改完成，增加了EXIT SUB语句