你能根据细胞内容来调整excel宏吗？

时间：2013-06-04 15:34:51

标签： excel vba ms-office

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

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

3 个答案:

答案 0 :(得分：2)

编辑第二列以过滤

列号是单元格（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

答案 1 :(得分：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

答案 2 :(得分：-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
相关问题
最新问题