如何使用 VBA 将条件应用于整个列中的“使用范围”作为 excel 中的循环？

Question

我是 VBA 的初学者，请帮助我。 在此图像（链接在段落末尾）中，我试图在包含与上部单元格名称不同的名称的单元格上方插入行。 请告诉我是否有更简单的方法可以做到这一点，或者如何将给定的 if else 条件应用于整个“G”列......

如果您不需要图像，我仍然在下面添加我的代码...

Sub ScanColumn()
    'Application.ScreenUpdating = False

    Dim varRange As Range
    Dim currentCell As String
    Dim upperCell As String
    Dim emptyCell As String
    
    currentCell = ActiveCell.Value
        
    bottomCell = ActiveCell.Offset(1, 0).Value

    emptyCell = ""
    
    
Dim intResult As Integer
intResult = StrComp(bottomCell, currentCell)

Dim emptyResult As Integer
emptyResult = StrComp(currentCell, emptyCell)



'I want to apply below condition to whole G column in used range

        If emptyResult = 0 Then
        ActiveCell.Select
        
        ElseIf intResult = 0 Then
        ActiveCell.Offset(1, 0).Select
        
        Else
        ActiveCell.Offset(1).EntireRow.Insert
        ActiveCell.Offset(2, 0).Select
        
        End If
End Sub

Answer 1

在这里，只需调用 function “evaluateColumn”并传递参数，例如“试用”子。

    Function evaluateColumn(column As String, startRow As Long, wsh As Worksheet)

    Dim lastRow As Long
    lastRow = wsh.Range(column & wsh.Rows.Count).End(xlUp).Row
    
    Dim i As Long: i = startRow
    Do While i < lastRow
        If wsh.Cells(i, column).Value <> wsh.Cells(i + 1, column).Value And wsh.Cells(i, column).Value <> "" And wsh.Cells(i + 1, column).Value <> "" Then
            wsh.Range(column & i + 1).EntireRow.Insert shift:=xlShiftDown, CopyOrigin:=xlFormatFromLeftOrAbove
            i = i + 1
            lastRow = lastRow + 1
        End If
        i = i + 1
    Loop
        
End Function

Sub trial()

evaluateColumn "G", 2, ThisWorkbook.Worksheets("Sheet2")

End Sub

Answer 2

从我的回答与下面的回答之间的差异可以看出，您的问题并不完全清楚。 我的代码是一个事件过程。 它将自动运行，因为您 select 是 G 列已使用范围内的单元格。

1. 如果所选单元格的值与其下方的单元格相同，则将选择下一行的单元格。
2. 如果两个单元格中的任何一个都有值，则将插入一个空白行并选择该行的单元格。 （如果您想要另一行启用插入下方的行。）
3. 如果上述任一条件为真，则不执行任何操作并继续用户所做的选择。

为了让这个代码工作，它必须安装在你想要操作的工作表的代码表中。 如果您将其安装在标准代码模块中，它将无法工作，例如Module1 。

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    
    Dim TriggerRange    As Range
    Dim Off             As Long         ' offset from Target for selection

    ' if more than one cell is selected choose the first cell
    If Target.Cells.CountLarge > 1 Then Set Target = ActiveCell
    
    Set TriggerRange = Range(Cells(2, "G"), Cells(Rows.Count, "G").End(xlUp))
    ' this code will run only if a cell in this range is selected
'     Debug.Print TriggerRange.Address(0, 0)
    If Not Application.Intersect(Target, TriggerRange) Is Nothing Then
        Application.EnableEvents = False
        With Target
            If .Value = .Offset(1).Value Then
                Off = 1
            ElseIf WorksheetFunction.CountA(.Resize(2, 1)) Then
                Rows(.Row).Insert
                ' Off = 1       ' or -1 to change the selection
            End If
            .Offset(Off).Select
        End With
        Application.EnableEvents = True
    End If
End Sub