您能否根据单元格内容调整excel宏的条件？

Question

为了工作，我下载了一系列的电子表格，其中一个单元格列中有测验名称。通常每个测验有5-10次尝试，电子表格中报告了大约10次测验。

我有一个宏，它按测验名称对数据进行排序，以便将尝试分组在一起，但我希望在每个分组前后添加一个空格，以便将不同的测验分开。你能用宏做到这一点吗？

例如，如果我有：

Quiz Name 1
Quiz Name 1
Quiz Name 1
Quiz Name 2
Quiz Name 2
Quiz Name 2

我可以有一个宏来识别测验名称的变化，并添加一个空格，使其看起来像：

Quiz Name 1
Quiz Name 1
Quiz Name 1
-blank row-
Quiz Name 2
Quiz Name 2
Quiz Name 2

我可以使用宏添加行，但我不知道如何对其进行条件调整。任何帮助都将不胜感激。

Answer 1

对第二列进行编辑以根据进行筛选

列号是单元(x，y)表示法的第二部分，其中row是第一个部分，因此此循环遍历所有列y中的所有行，因此将其更改为2应该会得到正确的结果。

Sub insertrows()
Dim lastrow As Integer
lastrow = Worksheets("Sheet1").Cells(Rows.Count, 2).End(xlUp).Row
For i = lastrow To 2 Step -1
If Cells(i, 2).Value <> Cells(i - 1, 2).Value Then
Rows(i).Insert
End If
Next i
End Sub

这个怎么样？

Sub insertrows()
Dim lastrow As Integer
lastrow = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
For i = lastrow To 2 Step -1
If Cells(i, 1).Value <> Cells(i - 1, 1).Value Then
Rows(i).Insert
End If
Next i
End Sub

Answer 2

是。您可以根据单元格内容调整excel宏的条件，并且可以使用宏来识别测验名称的更改位置并添加空格。

备注：，这不是一个聪明的答案，但简单地考虑到这个问题和它的表达方式，我的印象是，在尝试自己尝试之前，操作员只是想知道这是否可能。

因为我很多时候都想看看某件事是不是可能的，然后试着自己找出它是如何可能的，然后在我弄清楚之后，我然后尝试研究别人如何做到这一点，并将其与我自己的代码进行比较。我觉得当我这样做的时候，我对事物是如何工作的以及为什么会有更好的理解。而不是仅仅知道这一点就能实现这一点。

下面是一些代码来提供帮助：

Sub InsertRowAtChange()

Dim CurrentValue As String
Dim Lastinstance As Long
Dim CurrentCell As Range


CurrentValue = Range("A1").Value
Set CurrentCell = Range("A1")

Do While CurrentValue <> ""

    Lastinstance = Range("A:A").Find(What:=CurrentValue, After:=CurrentCell, LookIn:=xlFormulas, LookAt:= _
        xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

      Set CurrentCell = Range("A" & Lastinstance + 1)
      CurrentValue = CurrentCell

      Rows(Lastinstance + 1).Insert

Loop


End Sub 

另一种选择是，如果你不喜欢循环，你会更喜欢使用所有内置的Excel函数和公式来完成工作。

Sub InsertRowAtChange2()

Dim DataRange As Range
Dim LastRow As Long


LastRow = Range("B1048576").End(xlUp).Row

Set DataRange = Range("B2", Range("B" & LastRow))

With DataRange

     .EntireColumn.Insert 'Add a temp column for a formula

     .Offset(0, -1).FormulaR1C1 = "=IF(AND(NOT(ISNA(R[-1]C)),R[-1]C[1]<>RC[1]),1,"""")"

     .Offset(0, -1) = .Offset(0, -1).Value 'Remove Formulas

     Set DataRange = .Offset(0, -1).SpecialCells(xlCellTypeConstants, xlNumbers) 'Numbers represent changes in rows

 End With

 'Add a row at each change in data

 If WorksheetFunction.Count(DataRange) > 0 Then

    DataRange.EntireRow.Insert

 End If

     'Delete Temp Column

     DataRange.Columns(1).EntireColumn.Delete



On Error GoTo 0

Set DataRange = Nothing

End Sub

Answer 3

Sub Group_2()
Dim LASTROW As Long
Dim I As Long
Dim ROW_Beg As Long
Dim ROW_End As Long
I = 1
For I = 1 To 10000
    If Cells(I, 1).Value = -1 Then
        LASTROW = I - 1
    End If
Next

ROW_Beg = 0
ROW_End = 0

For I = 1 To LASTROW
    If (Cells(I, 1).Value = 2 Or Cells(I, 1).Value = 3 Or Cells(I, 1).Value = 4 Or Cells(I, 1).Value = 5 Or Cells(I, 1).Value = 6 Or Cells(I, 1).Value = 7 Or Cells(I, 1).Value = 8 Or Cells(I, 1).Value = 9 Or Cells(I, 1).Value = 10) Then
        If (ROW_Beg <> 0) Then
            ROW_End = I
        End If
    Else
        ROW_Beg = I + 1
    End If
    If ((ROW_Beg <> 0) And (ROW_End <> 0)) Then
        Rows(ROW_Beg & ":" & ROW_End).Group
        ROW_Beg = ROW_Beg + 1
        ROW_End = 0
    End If
Next I


ROW_Beg = 0
ROW_End = 0
    For I = 1 To LASTROW
    If (Cells(I, 1).Value = 3 Or Cells(I, 1).Value = 4 Or Cells(I, 1).Value = 5 Or Cells(I, 1).Value = 6 Or Cells(I, 1).Value = 7 Or Cells(I, 1).Value = 8 Or Cells(I, 1).Value = 9 Or Cells(I, 1).Value = 10) Then
        If (ROW_Beg <> 0) Then
            ROW_End = I
        End If
    Else
        ROW_Beg = I + 1
    End If
    If ((ROW_Beg <> 0) And (ROW_End <> 0)) Then
        Rows(ROW_Beg & ":" & ROW_End).Group
        ROW_Beg = ROW_Beg + 1
        ROW_End = 0
    End If
Next I

ROW_Beg = 0
ROW_End = 0
    For I = 1 To LASTROW
    If (Cells(I, 1).Value = 4 Or Cells(I, 1).Value = 5 Or Cells(I, 1).Value = 6 Or Cells(I, 1).Value = 7 Or Cells(I, 1).Value = 8 Or Cells(I, 1).Value = 9 Or Cells(I, 1).Value = 10) Then
        If (ROW_Beg <> 0) Then
            ROW_End = I
        End If
    Else
        ROW_Beg = I + 1
    End If
    If ((ROW_Beg <> 0) And (ROW_End <> 0)) Then
        Rows(ROW_Beg & ":" & ROW_End).Group
        ROW_Beg = ROW_Beg + 1
        ROW_End = 0
    End If
Next I

ROW_Beg = 0
ROW_End = 0
    For I = 1 To LASTROW
    If (Cells(I, 1).Value = 5 Or Cells(I, 1).Value = 6 Or Cells(I, 1).Value = 7 Or Cells(I, 1).Value = 8 Or Cells(I, 1).Value = 9 Or Cells(I, 1).Value = 10) Then
        If (ROW_Beg <> 0) Then
            ROW_End = I
        End If
    Else
        ROW_Beg = I + 1
    End If
    If ((ROW_Beg <> 0) And (ROW_End <> 0)) Then
        Rows(ROW_Beg & ":" & ROW_End).Group
        ROW_Beg = ROW_Beg + 1
        ROW_End = 0
    End If
Next I

    ROW_Beg = 0
ROW_End = 0
    For I = 1 To LASTROW
    If (Cells(I, 1).Value = 6 Or Cells(I, 1).Value = 7 Or Cells(I, 1).Value = 8 Or Cells(I, 1).Value = 9 Or Cells(I, 1).Value = 10) Then
        If (ROW_Beg <> 0) Then
            ROW_End = I
        End If
    Else
        ROW_Beg = I + 1
    End If
    If ((ROW_Beg <> 0) And (ROW_End <> 0)) Then
        Rows(ROW_Beg & ":" & ROW_End).Group
        ROW_Beg = ROW_Beg + 1
        ROW_End = 0
    End If
Next I

    ROW_Beg = 0
ROW_End = 0
    For I = 1 To LASTROW
    If (Cells(I, 1).Value = 7 Or Cells(I, 1).Value = 8 Or Cells(I, 1).Value = 9 Or Cells(I, 1).Value = 10) Then
        If (ROW_Beg <> 0) Then
            ROW_End = I
        End If
    Else
        ROW_Beg = I + 1
    End If
    If ((ROW_Beg <> 0) And (ROW_End <> 0)) Then
        Rows(ROW_Beg & ":" & ROW_End).Group
        ROW_Beg = ROW_Beg + 1
        ROW_End = 0
    End If
Next I

    ROW_Beg = 0
ROW_End = 0
    For I = 1 To LASTROW
    If (Cells(I, 1).Value = 8 Or Cells(I, 1).Value = 9 Or Cells(I, 1).Value = 10) Then
        If (ROW_Beg <> 0) Then
            ROW_End = I
        End If
    Else
        ROW_Beg = I + 1
    End If
    If ((ROW_Beg <> 0) And (ROW_End <> 0)) Then
        Rows(ROW_Beg & ":" & ROW_End).Group
        ROW_Beg = ROW_Beg + 1
        ROW_End = 0
    End If
Next I

    ROW_Beg = 0
ROW_End = 0
    For I = 1 To LASTROW
    If (Cells(I, 1).Value = 9 Or Cells(I, 1).Value = 10) Then
        If (ROW_Beg <> 0) Then
            ROW_End = I
        End If
    Else
        ROW_Beg = I + 1
    End If
    If ((ROW_Beg <> 0) And (ROW_End <> 0)) Then
        Rows(ROW_Beg & ":" & ROW_End).Group
        ROW_Beg = ROW_Beg + 1
        ROW_End = 0
    End If
Next I


    ROW_Beg = 0
ROW_End = 0
    For I = 1 To LASTROW
    If (Cells(I, 1).Value = 10) Then
        If (ROW_Beg <> 0) Then
            ROW_End = I
        End If
    Else
        ROW_Beg = I + 1
    End If
    If ((ROW_Beg <> 0) And (ROW_End <> 0)) Then
        Rows(ROW_Beg & ":" & ROW_End).Group
        ROW_Beg = ROW_Beg + 1
        ROW_End = 0
    End If
Next I
End Sub