检查单元格是否在Excel中有数据，然后将单元格添加到左侧的列中

如果我在Excel中有以下内容：

ABC (columns) abc (data) def (data) ghi (data) - - - (empty) 

和下面的validation下拉列表：

 With rng.Validation .Delete .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _ xlBetween, Formula1:="1,2" .IgnoreBlank = True .InCellDropdown = True .InputTitle = "" .ErrorTitle = "" .InputMessage = "" .ErrorMessage = "" .ShowInput = True .ShowError = True End With 

首先，我需要使用vba来检查一个单元格是否有数据，如果是这样，请将validation下拉列表添加到新列/单元格的左侧，如下所示：

  ABCD 1,2 abc 1,2 def 1,2 ghi - - - - 

在用户从下拉列表中select一个值之后，我需要第二个macros来根据所选的值在现有列的任意一侧添加更多列：

  ABCDEFG 1 a 1 b 1 c 1 (if 1 selected from dropdown) 2 d 2 e 2 f 2 (if 2 selected from dropdown) 2 g 2 h 2 i 2 (if 2 selected from dropdown) 

我是一个真正的初学者，所以任何帮助，不胜感激。

=======编辑================================

我已经制定了第一部分，其余的仍然是一个痛苦：

 Sub changeClass() Dim rng As Range Dim r As Range Set rng = Range(Cells(6, 2), Cells(6, 2).End(xlDown)) Dim rCell As Range For Each rCell In rng.Cells rCell.Offset(0, -1).Value = "Data" Next rCell For Each rCell In rng.Cells With rng.Offset(0, -1).Validation .Delete .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _ xlBetween, Formula1:="=$A$1:$A$3" .IgnoreBlank = True .InCellDropdown = True .InputTitle = "" .ErrorTitle = "" .InputMessage = "" .ErrorMessage = "" .ShowInput = True .ShowError = True End With Next rCell End Sub 

还有如何插入新的列，但不能插入新的数据：

 Sub newColumn() Dim rng As Range Dim crng As Range Dim r As Range With ActiveSheet LastCol = .Cells(5, .Columns.Count).End(xlToLeft).Column End With Set rng = Range(Cells(6, 1), Cells(6, 1).End(xlDown)) Set crng = Range(Cells(5, 1), Cells(5, LastCol)) Set drng = Range(Cells(4, 1), Cells(4, LastCol)) Dim rCell As Range Dim cCell As Range Dim dCell As Range For Each rCell In rng.Cells For Each cCell In crng.Cells cCell.Offset(-1, 0).Value = "columnMark" Next cCell Next rCell For Each dCell In drng.Cells If dCell.Value = "columnMark" Then dCell.EntireColumn.Offset(0, 1).Insert End If dCell.Value = "" Next dCell End Sub 

Answer 1

这里是一个例子。 粘贴到您的数据所在的图纸类模块。 过程Worksheet_Change触发了工作表中的所有更改，因此如果“目标”与已validation的范围相交，则代码应该validation，如果不是，则退出该过程。 如果你更改了validation组合中的select，那么它将不会删除以前的设置，这只是一个例子:-)。

 Private Sub Worksheet_Change(ByVal Target As Range) Dim targetSheet As Worksheet Dim i As Byte Dim lastColumn As Byte Dim firstColumn As Byte Dim actualColumn As Byte Application.EnableEvents = False Application.ScreenUpdating = False Set targetSheet = Target.Worksheet With targetSheet firstColumn = Target.Offset(columnoffset:=1).Column lastColumn = .Cells(Target.Row, .Columns.Count).End(xlToLeft).Column actualColumn = firstColumn For i = firstColumn To lastColumn If (.Cells(Target.Row, actualColumn).Value <> "") Then ' if next cell isn't empty insert new one If (.Cells(Target.Row, actualColumn + 1).Value <> "") Then .Cells(Target.Row, actualColumn + 1).Insert Shift:=xlToRight End If .Cells(Target.Row, actualColumn + 1).Value = Target.Value actualColumn = actualColumn + 2 Else actualColumn = actualColumn + 1 End If Next i End With Application.EnableEvents = True Application.ScreenUpdating = True End Sub