Question

我有一个问题，通过我的pivottable的值循环。我想检查所选列（输入框）的值，如果它高于0.12，则更改单元格的颜色并将第一列上的值复制到另一个工作表。

以某种方式，由（输入框）选择的列的单元格值被误读，并且宏将错误的ID复制到另一个工作表中。

表格详情：列A：ID（如果满足条件，则需要复制到另一个工作表）， B列至M列（如果> 0.12则要改变颜色的细胞）

你能帮帮我吗？

        Option Explicit

Sub mcruplift()

Dim i As Integer
Dim j As Integer

Dim rm As Integer


Dim result1 As Integer


Dim colmn As Integer
Dim weight As Integer


result1 = InputBox("welke maand wil je controleren? Waar wil je de controle starten?")

colmn = result1 + 1
i = 11
j = 3



Do Until IsEmpty(Cells(i, 1))

            If IsNumeric(Cells(i, colmn)) = True Then

            weight = Cells(i, colmn).Value

                    Select Case weight

                        Case 0.12 To 0.17

                        Cells(i, colmn).Interior.ColorIndex = 44

                                rm = Cells(i, 1)
                                Worksheets("Resultaat").Activate
                                Cells(j, 1) = rm
                                j = j + 1
                                Worksheets("sheet5").Activate

                        Case 0.17 To 0.25

                        Cells(i, colmn).Interior.ColorIndex = 45

                                rm = Cells(i, 1)
                                Worksheets("Resultaat").Activate
                                Cells(j, 1) = rm
                                j = j + 1
                                Worksheets("sheet5").Activate

                        Case Is > 0.25

                        Cells(i, colmn).Interior.ColorIndex = 46


                                rm = Cells(i, 1)
                                Worksheets("Resultaat").Activate
                                Cells(j, 1) = rm
                                j = j + 1
                                Worksheets("sheet5").Activate

                    End Select

            End If

i = i + 1

Loop



End Sub

Answer 1

因此，由于我在评论中提出的所有未解答的问题，很难给出明确的答案。这可以整理，但可能会推动事情向前发展。您应该使用显式工作表引用替换Activesheet，理想情况下还要确保使用正确的工作簿。

1）在定期更换床单时，您没有完全符合资格。

2）你有整数应该是Longs以避免溢出和整数应该加倍以允许正确的条件评估。

3）你还说只有＆gt; .12重量应该是彩色的，但你的代码样本根据不同的重量类别有各种不同的颜色格式。

4）数据透视表具有databodyrange属性，您可以专门定位列 - 所以其他选项包括使用过滤器循环这些或实际上。

所以，走出困境：

您可以从以下内容开始：

Option Explicit

Sub mcruplift()

    Dim i As Long
    Dim j As Long
    Dim rm As Long
    Dim result1 As Long
    Dim colmn As Long
    Dim weight As Double

    result1 = InputBox("welke maand wil je controleren? Waar wil je de controle starten?") 'which month do you want to check? Where do you want to start the check?

    colmn = result1 + 1
    i = 11
    j = 3

    With ActiveSheet

        Do Until IsEmpty(.Cells(i, 1))

            .Cells(i, colmn).Interior.ColorIndex = vbNormal 'Clear out existing

            If IsNumeric(.Cells(i, colmn)) Then

                weight = .Cells(i, colmn).Value

                Select Case weight

                Case 0.12 To 0.17

                    .Cells(i, colmn).Interior.ColorIndex = 44

                Case 0.17 To 0.25

                    .Cells(i, colmn).Interior.ColorIndex = 45

                Case Is > 0.25

                    .Cells(i, colmn).Interior.ColorIndex = 46


                End Select

                rm = .Cells(i, 1)

                Worksheets("Resultaat").Cells(j, 1) = rm

                j = j + 1

            End If

            i = i + 1

        Loop

    End With

    Worksheets("Sheet5").Activate

End Sub

与您声明的目标更接近：

Option Explicit

Sub mcruplift()

    Dim i As Long
    Dim j As Long
    Dim rm As Long
    Dim result1 As Long
    Dim colmn As Long
    Dim weight As Double

    result1 = InputBox("welke maand wil je controleren? Waar wil je de controle starten?") 'which month do you want to check? Where do you want to start the check?

    colmn = result1 + 1
    i = 11
    j = 3

    With ActiveSheet

        Do Until IsEmpty(.Cells(i, 1))

            .Cells(i, colmn).Interior.ColorIndex = vbNormal 'Clear out existing

            If IsNumeric(.Cells(i, colmn)) And .Cells(i, colmn) > 0.12 Then

                .Cells(i, colmn).Interior.ColorIndex = 44

                rm = .Cells(i, 1)

                Worksheets("Resultaat").Cells(j, 1) = rm

                j = j + 1

            End If

            i = i + 1

        Loop

    End With

    Worksheets("Sheet5").Activate

End Sub

Answer 2

通过您的数据透视表过滤而不是循环，而是在您想要的条件下过滤，而不是一次性更改所有感兴趣的单元格的颜色，并将这些单元格复制到其他表格一气呵成。

启动宏录制器以获取滤镜的语法。要获得有关如何引用数据透视表部分的语法，请参阅Jon Peltier的优秀文章： https://peltiertech.com/referencing-pivot-table-ranges-in-vba/

vba - 如果满足条件，则从pivot复制值

2 个答案: