0

仕事のために、セル列の 1 つにクイズ名が含まれる一連のスプレッドシートをダウンロードします。通常、クイズごとに 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

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

もう 1 つのオプションは、ループが気に入らない場合に備えて、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 に答える