Question

我表格中的组列包含1或2的值。我想使用按钮将值为1的行复制到Sheet2，将值为2的行复制到sheet3。如果单元格留空或者值既不是1也不是2，它也应该显示错误消息。

滚动无米宽组

112 150 130 1

由于我不熟悉编码，所以我遵循这种方法

检查单元格是否为空并生成错误消息
检查单元格是否包含1或2以外的值并生成错误消息
最后将值为1的行复制到Sheet2，并将所有值全部放在sheet3中

我需要帮助才能做到这一点是一种有效的方法。因为我必须保持文件的大小

enter code here

Private Sub CommandButton2_Click（）

Dim i As Integer

p = Sheet1.Range("l1").Value 'no. of filled cells in the range
Application.DisplayAlerts = False
Sheet1.Activate
    ''checking if the range is empty
    For i = 29 To p + 29
        If Sheet1.Range("l" & i).Value = "" Then
        MsgBox ("PLEASE ENTER THE SHRINKAGE GROUP FOR CELL NO. l" & i)
        Range("L" & i).Activate
        End
        End If
        Next i
    '' checking if the range contains values other than 1 or 2

    For i = 29 To p + 29
        If Sheet1.Range("l" & i).Value <> 1 And Sheet1.Range("l" & i).Value <> 2 Then
        MsgBox ("SHADE GROUP DOES NOT EXIST FOR CELL NO. l" & i)

        Range("L" & i).Activate
        End
        End If
        Next i

' sort based on the group

Range("a29:L300").Sort _
Key1:=Range("l29"), Header:=xlYes

'count the number of rolls in group 1
Dim x, y As Long
Dim a, b As Integer
x = Range("L" & Rows.Count).End(xlUp).Row
If x < 29 Then x = 29
a = Application.WorksheetFunction.CountIf(Range("L12:L" & x), 1) + 28
Range("M1").Value = a

' count the number of rolls in group 2
y = Range("L" & Rows.Count).End(xlUp).Row
If y < 29 Then y = 29
b = Application.WorksheetFunction.CountIf(Range("L12:L" & x), 2)
Range("n1").Value = b

'' copying groupwise to different sheet
Sheet1.Range("a29", "l" & a).Copy
Sheet2.Range("a5").PasteSpecial xlPasteAll
Sheet2.Range("a5").PasteSpecial xlPasteValuesAndNumberFormats
'' copying group 2
Sheet1.Range("a" & a + 1, "l" & a + b).Copy
Sheet5.Range("a5").PasteSpecial xlPasteAll
Sheet5.Range("a5").PasteSpecial xlPasteValuesAndNumberFormats

End Sub

Answer 1

为源数据和要复制的行之后的行创建命名范围。在这个例子中，我使用了＆＃34; source＆＃34;，＆＃34; range1＆＃34;和＆＃34; range2＆＃34;。然后，以下代码将源数据复制到适当的位置：

Sub copyData()
    Dim source As Range, range1 As Range, range2 As Range
    Dim r As Range
    Set source = Range("source")
    Set range1 = Range("range1")
    Set range2 = Range("range2")
    For Each r In source.Rows
        If r.Cells(1, 4).Value = 1 Then
            copyRow r, range1
        ElseIf r.Cells(1, 4).Value = 2 Then
            copyRow r, range2
        Else
            ' handle error here
        End If
    Next r
End Sub

Sub copyRow(data As Range, targetRange As Range)
    Set targetRange = targetRange.Resize(targetRange.Rows.Count + 1, targetRange.Columns.Count)
    For i = 1 To 3
        targetRange.Cells(targetRange.Rows.Count, i).Value = data.Cells(1, i).Value
    Next i
End Sub

这可能是一种更优雅的方式，这涉及到数组公式，但这应该可以解决问题。

用于验证每个单元格仅包含＆＃34; 1＆＃34;或者＆＃34; 2＆＃34;，您可以在我发表评论的地方添加其他代码，但您最好将其作为数据验证处理。

根据特定列

1 个答案: