Question

我有一个在主表单中组织的工作簿。每个项目有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

用于选择非空列的弹出用户表单选择空列

0 个答案: