popup式用户表单select非空列select空白列

我有一个工作簿是在主表中组织的。 每个项目有3行。 这些项目按行和列进行分组和分组。

我已经开发了几个报告选项。 这些报告根据主表中的特征识别某些项目，并将其复制到另一个表格中。 到现在为止还挺好。

我最后的任务看起来很简单，并基于我先前开发的逻辑。 我需要一个提示用户input列的popup窗口。 根据列input，我抓住所有非空的行（在其对应的3个组中）并复制它们。 正如我所指出的，这个逻辑在以前工作。 为了便于阅读，我在两组之间留下了空白的一行。

我把列input并转换为列号（感谢您和以前的职位！）。 问题是，代码正确地复制了组（非空条目），然后一旦它离开第一行分组，它开始复制通过非空条目。

我知道这些列中的条目是什么，并尝试使用一种关键方法 – 将已知条目转换为ascii并根据该条目检查单元格值。 仍然是一样的结果。

我想知道如果问题是代码驻留在用户窗体的事实？ 我需要将用户窗体与macros分开吗？ columnNumber以某种方式被覆盖（看起来这样）。 从以前的版本和故障排除可能有人工产物（未使用的variables）…

我承认这不是我所做过的最优雅的编码，但是我已经没有时间了（我只剩下几天就完成了整个项目）。 在这里，任何build议或帮助非常感谢。 非常感谢你:)

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