时间戳

首页 > 解决方案 > Excel VBA 宏给出了意想不到的结果？

excel - Excel VBA 宏给出了意想不到的结果？

问题描述

我有一个宏循环遍历工作表（Sheet4）以将数据放置在另一个工作表（Ark7）中。'rKvartal' 变量是从第三张表 (Ark4) 中获取的文本字符串。只有满足外循环中的两个条件，才会进入内循环。这部分有效。我的问题是宏列出了不小于或等于“rKvartal”变量的内部循环中的数据。（这必须在宏中完成）宏如下所示：

Dim C, C2 As Range
Dim rKvartal As String


Application.ScreenUpdating = False

    Ark7.Columns("B:F").ClearContents
    
    cValOffset = 101
    cVal = 2 'row# where data in rLog (ark7) goes to
    rKvartal = Sheet3.Range("AP24") 'Criteria to filter data
    
    'Create headers for use in the list being created
    Ark7.Cells(1, 2).Value = "ID"
    Ark7.Cells(1, 3).Value = "Sansynlighed"
    Ark7.Cells(1, 4).Value = "Konsekvens"
    Ark7.Cells(1, 5).Value = "Sum"
    Ark7.Cells(1, 6).Value = "Kvartal"
    
    For Each C In Sheet4.Range("W15:W114")
        If C = "Risk" Or C = "Occured" Then
            For Each C2 In Sheet4.Range("K15:K114")
                    If C2 <= rKvartal Then
                        'All cells that are either a risk or occured and that is less than or equal to e.g Q4 2021
                        Ark7.Cells(cVal, 2).Value = C.Offset(0, -21).Value
                        Ark7.Cells(cVal, 3).Value = C.Offset(0, -15).Value
                        Ark7.Cells(cVal, 4).Value = C.Offset(0, -14).Value
                        Ark7.Cells(cVal, 5).Value = C.Offset(0, -13).Value
                        Ark7.Cells(cVal, 6).Value = C.Offset(0, -12).Value
                        cVal = cVal + 1
                        Exit For
                    End If
            Next C2
        End If
    Next C
    
    ActiveWorkbook.Worksheets("rLog").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("rLog").Sort.SortFields.Add2 key:=Range("E2"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
        With ActiveWorkbook.Worksheets("rLog").Sort
            .SetRange Range("B2:F100")
            .Header = xlNo
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
        
    Ark7.Activate
    Ark7.Range(Cells(1, 2), Cells(8, 6)).Select 
    Application.CutCopyMode = False
    ActiveSheet.ListObjects.Add(xlSrcRange, Ark7.Range(Cells(1, 2), Cells(8, 6)), , xlYes).Name = "RisikoSorteret" 'Laver en tabel eller liste
    ActiveSheet.ListObjects("RisikoSorteret").TableStyle = "Tabeltypografi 3" 'Giver listen en typografi
End Sub

数据 。 意想不到的结果

数据源

标签： excelvba

解决方案

我自己想通了。内循环是多余的。它只需要标准而不是另一个循环：

    For Each C In Sheet4.Range("W15:W114")
        If C = "Risiko" Or C = "Indtraf" Then
            If C.Offset(0, 1).Value <= rKvartal Then
                'Alle risici der opfylder kriterierne
                Ark7.Cells(cVal, 2).Value = C.Offset(0, -21).Value
                Ark7.Cells(cVal, 3).Value = C.Offset(0, -15).Value
                Ark7.Cells(cVal, 4).Value = C.Offset(0, -14).Value
                Ark7.Cells(cVal, 5).Value = C.Offset(0, -13).Value
                Ark7.Cells(cVal, 6).Value = C.Offset(0, 1).Value
                cVal = cVal + 1
            End If
        End If
    Next C

推荐阅读