根据Excel中的另一个单元格强制禁用空单元格

时间:2014-06-27 09:30:55

标签: excel vba

是否可以在Excel中根据另一个单元格强制禁止空单元格? 我的意思是如果你输入例如A1中的casenumber,那么你必须在B1和C1中输入一些东西。 它应该是动态的,因此它应该适用于B列和C列中的所有单元格,但它应该只查看A列中同一行中的单元格。

更多细节......

由于原始工作表未设计为导出,因此我需要在导出之前将适当的数据复制到另一个工作表。

所以我有一张无用的纸张,填写了单元格,我复制到另一张纸上的更好的布局,然后我导出到csv。

我使用此代码复制数据:

Private Sub CopyAllNonBlanksInRange()     使用表格(" Flexhal Tilbudsregistrering")     .Columns(" E")。SpecialCells(xlCellTypeConstants)。复制目的地:=表格(" Ark1")。范​​围(" A1")     .Columns(" F")。SpecialCells(xlCellTypeConstants).Copy Destination:= Sheets(" Ark1")。Range(" B1")     .Columns(" G")。SpecialCells(xlCellTypeConstants).Copy Destination:= Sheets(" Ark1")。Range(" C1")     结束 结束子

所以问题出在复制过程中,因为它应该只复制包含数据的单元格。

此时我只能看到我必须遍历所有行以检查它们是否已填写并根据它进行复制。这看起来像一团糟,我甚至不确定如何做到这一点。

2 个答案:

答案 0 :(得分:0)

这可以通过事件宏实现。宏将强制执行此方案:

  1. 所有单元格开始,但 A1
  2. 除外
  3. 一旦用户填写 A1 B1 C1 成为未受保护的
  4. 一旦用户填写 B1 C1,A2 变为不受保护
  5. 修改#1

    首先输入并运行此宏以设置工作表:

    Sub SETUPP()
        ActiveSheet.Unprotect
        Application.EnableEvents = False
        Cells.Clear
        Cells.Locked = False
            With Range("A1")
                .Select
                Cells.Locked = True
                .Locked = False
            End With
        ActiveSheet.Protect
        Application.EnableEvents = True
    End Sub
    

    然后在工作表代码区域中输入此事件宏:

    Private Sub Worksheet_Change(ByVal Target As Range)
    Dim A As Range, N As Long
    Set A = Range("A:A")
    N = Target.Row
    If Not Intersect(Target, A) Is Nothing Then
        ActiveSheet.Unprotect
            Target.Offset(0, 1).Select
            Cells.Locked = True
            Range("B" & N & ":C" & N).Locked = False
        ActiveSheet.Protect
    Else
        If Application.WorksheetFunction.CountA(Range("B" & N & ":C" & N)) = 2 Then
            ActiveSheet.Unprotect
                Range("A" & N + 1).Select
                Cells.Locked = True
                Range("A" & N + 1).Locked = False
            ActiveSheet.Protect
        End If
    End If
    End Sub
    

    因为它是工作表代码,所以很容易安装和自动使用:

    1. 右键单击Excel窗口底部附近的选项卡名称
    2. 选择查看代码 - 这会打开一个VBE窗口
    3. 粘贴内容并关闭VBE窗口
    4. 如果您有任何疑虑,请先在试用工作表上试用。

      如果保存工作簿,宏将随之保存。 如果您在2003年之后使用的是Excel版本,则必须保存 该文件为.xlsm而不是.xlsx

      删除宏:

      1. 按上述方式调出VBE窗口
      2. 清除代码
      3. 关闭VBE窗口
      4. 要了解有关宏的更多信息,请参阅:

        http://www.mvps.org/dmcritchie/excel/getstarted.htm

        http://msdn.microsoft.com/en-us/library/ee814735(v=office.14).aspx

        要了解有关事件宏(工作表代码)的更多信息,请参阅:

        http://www.mvps.org/dmcritchie/excel/event.htm

        必须启用宏才能使其生效!

答案 1 :(得分:0)

@ gary's我确定你的衣服是有效的,但自从上次我设法通过这段代码解决了它:

Dim celleværdi As String
Dim i As Long
Dim række As Long
Dim startcelle As String
række = 1
nederstecelle = "E65000"

Range(nederstecelle).End(xlUp).Select 'ud fra variblen celle finder vi den sidste celle med værdi i
sidstecelle = ActiveCell.Row
'MsgBox sidstecelle

For i = 1 To sidstecelle 'looper kun igennem rækkerne indtil sidste udfyldte celle
    If Cells(i, 5).Value <> "" Then 'er celleværsien forskellig fra tom, så kopiere den over i Ark2
         Cells(i, 5).Select
         Range(ActiveCell, ActiveCell.Offset(0, 2)).Copy Destination:=Sheets("Ark1").Cells(række, 1)
         række = række + 1
     End If
Next i

你的代码看起来有点太过分了。 我仍然得到空单元格,但是现在得到了它们应该复制的内容,那么如果单元格为空,我可能会在我自己的文本中进行检查和粘贴。

但是感谢你的帮助,如果我没有解决它的问题,我相信它会帮助我。