Question

我目前正在处理Excel VBA宏脚本，其中将对活动单元格执行简单的TRUE或False测试。我的问题是，我不能让这个工作直到列表的结尾。它只运行一次并结束程序。我需要这个VB脚本来执行IF＆amp; ELSE测试到列表的底部。

问题描述：

假设我在A1到A9999之间有一个日期列表，在它旁边（F1：F9999），还有一个列表，上面有文字。 F1：F9999列表仅包含两个值。（a）相同日期和（b）不相同。

在列表F1：F9999中执行True或False测试。
如果活动单元格值等于文本“SAME DATE”（TRUE），它将忽略并移动到列表中的下一个项目，然后再次执行数字1.
如果活动单元格值等于文本“SAME DATE”（FALSE），它将在其上方插入一行，然后移动到列表中的下一个项目，然后再次执行数字1
TRUE或FALSE测试将一直运行到列表末尾。
如果TRUE或FALSE测试到达列表底部，它将停止运行。
顺便说一句，列表中的项目数不一致。我只是把F1：F9999放在那里。

这是我的代码！

Sub IFandElseTest()
If ActiveCell.Value = "Same Date" Then
Range(Selection, Cells(ActiveCell.Row, 1)).Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
ActiveCell.Offset(1, 0).Select
Else:
ActiveCell.Offset(1, 0).Select
Range(Selection, Cells(ActiveCell.Row, 1)).Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
End If


End Sub

enter image description here

如果你可以帮我解决这个问题。

Answer 1

试一试。

<强>解释

您应该避免使用.Select/ActiveCell等。您可能希望看到此LINK
使用最后一行时，最好不要硬编码值，而是动态查找最后一行。您可能希望看到此LINK
使用对象，如果当前工作表不是您要使用的工作表，该怎么办？
以下FOR循环将从下方穿过该行并向上移动。

<强>代码：

Sub Sample()
    Dim ws As Worksheet
    Dim LRow As Long, i As Long
    Dim insertRange As Range

    '~~> Chnage this to the relevant sheet
    Set ws = ThisWorkbook.Sheets("Sheet1")

    '~~> Work with the relevant sheet
    With ws
        '~~> Get the last row of the desired column
        LRow = .Range("E" & .Rows.Count).End(xlUp).Row

        '~~> Loop from last row up
        For i = LRow To 1 Step -1
            '~~> Check for the condition
            '~~> UCASE changes to Upper case
            '~~> TRIM removes unwanted space from before and after
            If UCase(Trim(.Range("E" & i).Value)) = "SAME DATE" Then
                '~~> Insert the rows
                .Rows(i).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            End If
        Next i
    End With
End Sub

<强>截图：

enter image description here

跟进评论

真的有用！但是，最后一次修改。在您的代码中：设置ws = ThisWorkbook.Sheets（“Sheet1”）您是否可以将WS设置为活动工作表。原因是因为工作表的名称是唯一的，也不一致。

就像我提到的，在上面的第一个链接以及评论中，请不要使用Activesheet。使用不会更改的工作表的CodeNames。请参见下面的屏幕截图。

enter image description here

Blah Blah是您在工作表标签中看到的工作表的名称，但Sheet1是不会更改的CodeName。即，您可以将工作表的名称从Blah Blah更改为Kareen，但在VBA编辑器中，您会注意到Codename没有更改：）

更改代码

Set ws = ThisWorkbook.Sheets("Sheet1")

到

'~~> Replace Sheet1 with the relevant Code Name
Set ws = [Sheet1]

Answer 2

修改：

如果省略r.copy行，它或多或少与Siddharth Rout的解决方案完全相同

Sub insrow()
  Dim v, r As Range
  Set r = [d1:e1]
  v = r.Columns(1).Value
  Do
   ' r.copy
   If v = "Same Date" Then r.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
   Set r = r.Offset(1)
   v = r.Columns(1).Value
  Loop Until v = ""
End Sub

如果行超过第9999行，但尚未包含结束条件，但这应该很容易添加......

Excel宏重复IF和其他

2 个答案: