0

为了工作，我下载了一系列电子表格，其中一个单元格列中有测验名称。每个测验通常有 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

我可以用宏添加一行，但我不知道如何调节它。任何帮助，将不胜感激。

4

3 回答 3

2

编辑第二列以过滤

列号是单元格（x，y）表示法的第二部分，其中行是第一部分，因此这会循环遍历指定 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
于 2013-06-04T15:57:44.700 回答
0

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

注意：这并不是一个聪明的答案，而只是给出了问题和措辞的方式，我的印象可能是 OP 只是想知道它是否可能，然后再尝试自己尝试.

因为我很多时候想看看是否有可能，然后自己尝试弄清楚它是如何可能的，然后在我弄清楚之后，我尝试研究其他人如何/将如何做到这一点，并将其与我自己的代码进行比较。我觉得当我以这种方式做事时，我对事情的运作方式和原因有了更好的理解。而不是仅仅拥有这方面的知识就可以做到这一点。

这里有一些代码可以提供帮助：

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
于 2013-06-04T15:39:32.533 回答
-1 
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
于 2014-09-11T07:10:27.160 回答