我有一个工作表数据,其中包含与这些公司相对应的公司和百分比列表。在工作表仪表板上,我有一个阈值(比如说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
我的代码在一次迭代中发布所有公司,这是不正确的,因为它没有考虑所有公司的所有百分比,然后它提示我保存我不理解的电子表格。
如果有人能提供帮助,那就太棒了
答案 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