循环遍历列表,将值与阈值进行比较,然后复制并粘贴相应的值

时间:2017-06-06 14:58:03

标签: excel vba excel-vba

我有一个工作表数据,其中包含与这些公司相对应的公司和百分比列表。在工作表仪表板上,我有一个阈值(比如说20%)

我想查看每家公司的百分比,如果百分比低于阈值(20%),那么我想将该公司复制到工作表仪表板上B列的下一个可用行中。

我到目前为止的代码是:

Sub companydraw()

Set wsDest = Sheets("Dashboard")
Set wsData = Sheets("Data")


wsDest.Columns("B").Rows(7 & ":" & wsDest.Rows.Count).ClearContents

lr = wsData.UsedRange.Rows.Count

Dim rRng As Range

Set rRng = wsData.Range("W5: W418")

For Each i In rRng

If i.Value > wsDest.Range("F2").Value Then

    wsData.Range("N5:N" & lr).Copy wsDest.Range("B" & Rows.Count).End(3)(2)

End If
Next i

End Sub

我的代码在一次迭代中发布所有公司,这是不正确的,因为它没有考虑所有公司的所有百分比,然后它提示我保存我不理解的电子表格。

如果有人能提供帮助,那就太棒了

1 个答案:

答案 0 :(得分:1)

查看脚本,您希望检查数据表中W列中的值与目标表中F2的值,然后将相应行数据表中N列的值复制到目标中的B列下一个可用行中的工作表。

这应该这样做:

Sub companydraw()
Dim wsDest As Worksheet
Dim wsData As Worksheet
Dim i As Integer
Dim lastrow As Integer
Dim writerow As Integer

Set wsDest = Worksheets("Dashboard")
Set wsData = Worksheets("Data")

writerow = wsDest.Range("B65536").End(xlUp).Row + 1
lastrow = wsData.UsedRange.Rows.Count

For i = 2 To lastrow
    If wsData.Range("W" & i).value < wsDest.Range("F2").value Then 'F2 holds the threshold value
        wsDest.Range("B" & writerow).value = wsData.Range("N" & i).value
        writerow = writerow + 1
    End If
Next i

Set wsData = Nothing
Set wsDest = Nothing
End Sub