1

メイン シート内に編成されたワークブックがあります。すべてのアイテムには 3 つの行があります。これらの項目は、行と列によってグループ化およびサブグループ化されます。

私はいくつかの報告オプションを開発しました。これらのレポートは、メイン シートの特性に基づいて特定のアイテムを識別し、それらを別のシートにコピーします。ここまでは順調ですね。

私の最終的なタスクは単純で、私が開発した事前のロジックに基づいているように見えます。ユーザーに列の入力を求めるポップアップ ウィンドウが必要です。列の入力に基づいて、空でないすべての行 (対応する 3 つのグループ内) を取得し、それらをコピーします。前述のとおり、このロジックは以前は機能していました。読みやすいように、グループ間に空白行を残しています。

列の入力を受け取り、列番号に変換します (あなたと以前の投稿に感謝します!)。問題は、コードがグループを (空白以外のエントリで) 正しくコピーし、最初の行のグループ化を終了すると、空白以外のエントリのコピーを開始することです。

これらの列のエントリが何であるかを知っており、キーメソッドを使用してみました-既知のエントリをASCIIに変換し、それに対してセル値をチェックしました。それでも、同じ結果です。

問題は、コードがユーザーフォームに存在するという事実であるかどうか疑問に思っていますか? ユーザーフォームをマクロから分離する必要がありますか? columnNumber が何らかの形で上書きされています (そのように見えます)。以前のバージョンとトラブルシューティングからのアーティファクト (未使用の変数) がある可能性があります...

これは私が行った中で最も洗練されたコーディングではありませんが、時間がなくなりました (このプロジェクト全体に数日しか残っていません)。ここにあります。どんなアドバイスや助けも大歓迎です。よろしくお願いします:)

Private Sub Cancel_Click()

UserForm4.Hide

End Sub

Private Sub Go_Click()
    Dim Test As String
    Dim colNumber, columnNumber As Integer
    Dim m As Integer
    Dim ws2 As String
    Dim i, j, k, r As Integer
    Dim BlankRow2
    Dim ColorCode As Integer
    Dim RqtRow As Integer
    Dim Item As Integer
    Dim ColVal, AscCol As String
    Dim Row1Value, Row2Value, Row3Value As Integer

    ' Initialize Variables
    ws1 = "Requirements_Matrix"
    ws2 = "OUTPUT"
    RqtRow = 8
    BlankRow2 = 4
    Item = BlankRow2
    Lastrow1 = Sheets(ws1).Cells(Rows.Count, "A").End(xlUp).Row
    Lastcol1 = Sheets(ws1).Cells(1, Columns.Count).End(xlToLeft).Column
    Lastrow2 = Sheets(ws2).Cells(Rows.Count, "A").End(xlUp).Row
    Lastcol2 = Sheets(ws2).Cells(1, Columns.Count).End(xlToLeft).Column

    Test = UserForm4.WhichTest.Value
    If Test <> "" Then
        colLetter = UCase(Test)
        colNumber = 0
        For m = 1 To Len(colLetter)
            colNumber = colNumber + (Asc(Mid(colLetter, Len(colLetter) - m + 1, 1)) - 64) * 26 ^ (m - 1)
        Next
        columnNumber = colNumber
        If (columnNumber < 24) Or (columnNumber > 136) Then
           UserForm5.Show 'outside test columns - do not have time to execute further error testing...
        Else 'Copy requirements from Requirements_Matrix Sheet to Output Sheet
            With Sheets(ws2)
              Sheets(ws2).Select
              Rows("4:5000").Select
              Selection.Delete Shift:=xlUp
           End With

        Sheets(ws1).Select
           For i = 8 To Lastrow1  'find non-empty cells
              If Sheets(ws1).Cells(i, 3).Interior.ColorIndex = 34 Then
                  Row3Value = Sheets(ws1).Cells(i, 3).Value
              End If

            If Sheets(ws1).Cells(i, 2).Interior.ColorIndex = 44 Then
              Row2Value = Sheets(ws1).Cells(i, 2).Value
            End If

            If Sheets(ws1).Cells(i, 1).Interior.ColorIndex = 37 Then
              Row1Value = Sheets(ws1).Cells(i, 1).Value
            End If

           If Sheets(ws1).Cells(i, 5) = "Requirement" Then 'Requirement Row
              RqtRow = i
           End If

           If (Sheets(ws1).Cells(i, columnNumber).Value <> Empty) And _
           Sheets(ws1).Cells(i, 3).Interior.ColorIndex <> 34 And _
           Sheets(ws1).Cells(i, 2).Interior.ColorIndex <> 44 And _
           Sheets(ws1).Cells(i, 1).Interior.ColorIndex <> 37 Then
               k = RqtRow + 2
               Increment = BlankRow2 + 2
               Sheets(ws1).Select
                 Rows(RqtRow & ":" & k).Select  'select requirement block containing non-blank cell
                 Selection.Copy

                 Sheets(ws2).Select
                 Range(BlankRow2 & ":" & Increment).Select
                 ActiveSheet.Paste
                 ActiveSheet.Cells(BlankRow2, 1).Value = Row1Value
                 ActiveSheet.Cells(BlankRow2, 2).Value = Row2Value
                 ActiveSheet.Cells(BlankRow2, 3).Value = Row3Value

                BlankRow2 = Increment + 2 'leave a blank row between requirements

             End If
         Next

      End If
    Else
       UserForm5.Show
    End If
    UserForm4.WhichTest.Value = Empty
    UserForm4.Hide
End Sub
4

0 に答える 0