Question

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

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

1 个答案: