在列表中循环，将值与阈值进行比较，然后复制并粘贴相应的值

我有一个工作表数据与公司名单和百分比相应的这些公司。 在工作表仪表板上，我有一个阈值（比如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 

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

如果有人能帮助它将是惊人的

Answer 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