Vba 循环检查单元格是否包含值,然后将其添加到另一个工作表中的单元格中

Vba 循环检查单元格是否包含值,然后将其添加到另一个工作表中的单元格中,vba,loops,Vba,Loops,我正在尝试创建一个摘要图表,其中仅包含1级零件的标称权重和最大权重。因此,我的代码读取第一张图纸上的level 1列,如果level=1,则在第二张图纸上打印偏移单元值。我正试图打印主要组件名称、最大和标称重量,因为它们变化很大。但这不起作用。有什么想法吗 这是我的excel文件 这是到目前为止我的代码 Sub trial() Dim ws1 As Worksheet, ws2 As Worksheet Dim Group As Range, Mat As Range

我正在尝试创建一个摘要图表,其中仅包含1级零件的标称权重和最大权重。因此,我的代码读取第一张图纸上的level 1列,如果level=1,则在第二张图纸上打印偏移单元值。我正试图打印主要组件名称、最大和标称重量,因为它们变化很大。但这不起作用。有什么想法吗

这是我的excel文件

这是到目前为止我的代码

Sub trial()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim Group As Range, Mat As Range
    Dim CurCell_1 As Range, CurCell_2 As Range

    Application.ScreenUpdating = False


    Set ws1 = Sheets("Major Assys")
    Set ws2 = Sheets("Summary")

    For Each Group In ws1.Range("B4:B200")
        Set CurCell_2 = ws1.Range("B6")
        For Each Mat In ws1.Range("B4:B200")
            Set CurCell_1 = ws1.Cells(Mat.Row, Group.Column)
            If CurCell_1 = 1 Then
            If Not IsEmpty(CurCell_1) Then
                CurCell_2.Value = CurCell_1.Value
                Set CurCell_2 = CurCell_2.Offset(1)
            End If
            End If
        Next
    Next

    Application.ScreenUpdating = True
End Sub

从您的屏幕截图来看,这段代码将非常有效

Sub MakeSummary()
    Dim oRng1 As Range, oRng2 As Range
    Dim oWS1 As Worksheet, oWS2 As Worksheet, i As Long

    ' Initial cell to check
    Set oWS1 = ThisWorkbook.Worksheets("Major Assys")
    Set oRng1 = oWS1.Range("A4")

    ' Initial cell to store
    Set oWS2 = ThisWorkbook.Worksheets("Summary")
    Set oRng2 = oWS2.Range("B6")

    ' Clear original data on Summary
    i = 0
    Do Until IsEmpty(oRng2.Offset(i, 0))
        oRng2.Offset(i, 0).EntireRow.ClearContents
        i = i + 1
    Loop

    ' Look for Level 1's on "Major Assys", then put in to "Summary"
    Do Until IsEmpty(oRng1)
        If oRng1.Value = 1 Then
            oRng2.Value = oRng1.Offset(0, 2).Value ' Description
            oRng2.Offset(0, 1).Value = oRng1.Offset(0, 3).Value ' Nominal
            oRng2.Offset(0, 2).Value = oRng1.Offset(0, 5).Value ' Max
            Set oRng2 = oRng2.Offset(1, 0) ' Move to next row to store
        End If
        Set oRng1 = oRng1.Offset(1, 0) ' Move to next row to check
    Loop

    ' Clean up
    Set oRng1 = Nothing
    Set oWS1 = Nothing
    Set oRng2 = Nothing
    Set oWS2 = Nothing
End Sub

这不起作用,尽管我没有看到您在将其设置为“摘要”工作表后使用ws2。这就是你所说的“摘要不更新”的意思吗?不知道为什么在同一范围内使用双循环。