excel - Excel 宏重复 IF 和 Else

Question

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

问题描述：

假设我有一个从 A1 到 A9999 的日期列表，在它旁边 (F1:F9999) 还有一个包含文本的列表。F1:F9999 列表仅包含两个值。(a) 相同日期和 (b) 不相同。

1. 在列表 F1:F9999 中执行真假测试。

2. 如果活动单元格值等于文本“SAME DATE”(TRUE)，它将忽略并移至列表中的下一项，然后再次执行第 1 项。

3. 如果活动单元格值等于文本“SAME DATE”（FALSE），它将在其上方插入一行，然后移动到列表中的下一项，然后再次执行数字 1
4. TRUE 或 FALSE 测试将一直运行到列表末尾。
5. 如果 TRUE 或 FALSE 测试到达列表底部，它将停止运行。
6. 顺便说一下，列表中的项目数并不一致。我只是把 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

如果您能在这方面帮助我，请不胜感激。

Answer 1

试试这个。

解释：

1. 您应该避免使用.Select/ActiveCell等。您可能希望看到此链接
2. 处理最后一行时，最好不要硬编码值，而是动态查找最后一行。您可能想查看此链接
3. 使用对象，如果当前工作表不是您要使用的工作表怎么办？
4. 下面的 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

截屏：

评论跟进

它真的奏效了！但是，最后的修改。在您的代码中： Set ws = ThisWorkbook.Sheets("Sheet1") 您是否可以将 WS 设置为活动工作表。这样做的原因是因为工作表的名称唯一且不一致。

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

Blah BlahSheet1是您在工作表选项卡中看到的工作表的名称，但CodeName不会更改。即，您可以将工作表的名称从Blah Blahto sayKareen但在 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 行，这还不包括结束条件，但这应该很容易添加......