如果源单元格不为空,则更新范围,否则跳到下一个

时间:2017-05-12 02:04:04

标签: excel vba excel-vba

我似乎无法弄清楚我的代码的一个条件。我也是VBA的初学者。简而言之,我在一个包含我的过滤器值的工作表上有一个切片器,我有一个19个单元格的范围,可以使用我使用数据验证设置的下拉列表进行更新。

当在源工作表上的范围的任何单元格中选择一个值时(源范围是M8:M26),我需要它来更新另一个工作簿范围内的相应单元格(不是像源工作簿)。例如,当过滤器在desk1上时,M8将更新AB335,M9将更新AB358等...我最难解决如何循环更新,因此如果源范围中的第一个单元格为空,请跳过到下一个并继续更新。

如果单元格为空,我也不希望它使用空值覆盖目标范围单元格,到目前为止,这似乎与我的代码一起使用。如果在源范围上以随机顺序更新值,我就无法更新它。奇怪的警告是,如果我输入所有值而不跳过单元格,它将更新正常。如果前一个单元格没有选择,我怎样才能弄清楚如何移动到下一个单元格并继续更新?这是我到目前为止的代码:

      Sub UpdateRisk_Click()
Dim wksSource As Worksheet, wksDest As Worksheet
Dim strArray(0 To 18)    As String
Dim Arng            As Range
Dim Brng            As Range
Dim cell            As Range
Dim counter         As Long

Set wksSource = ActiveWorkbook.Sheets("By Risk Pivot")
Set wksDest = ActiveWorkbook.Sheets("(NEW) Full Data")
Set Arng = wksDest.Range("AB335,AB358,AB379,AB380,AB382,AB383,AB386,AB391,AB404,AB409,AB410,AB412,AB413,AB423,AB427,AB432,AB438,AB442,AB443,AB444")
Set Brng = wksDest.Range("AB109,AB130,AB151,AB152,AB155,AB157,AB159,AB166,AB178,AB185,AB186,AB187,AB188,AB193,AB197,AB199,AB204,AB206,AB208,AB209")

counter = 0

strArray(0) = wksSource.Range("M8")
strArray(1) = wksSource.Range("M9")
strArray(2) = wksSource.Range("M10")
strArray(3) = wksSource.Range("M11")
strArray(4) = wksSource.Range("M12")
strArray(5) = wksSource.Range("M13")
strArray(6) = wksSource.Range("M14")
strArray(7) = wksSource.Range("M15")
strArray(8) = wksSource.Range("M16")
strArray(9) = wksSource.Range("M17")
strArray(10) = wksSource.Range("M18")
strArray(11) = wksSource.Range("M19")
strArray(12) = wksSource.Range("M20")
strArray(13) = wksSource.Range("M21")
strArray(14) = wksSource.Range("M22")
strArray(15) = wksSource.Range("M23")
strArray(16) = wksSource.Range("M24")
strArray(17) = wksSource.Range("M25")
strArray(18) = wksSource.Range("M26")

For Each cell In Arng
    If (strArray(counter) <> "") And (ActiveWorkbook.SlicerCaches("Slicer_Global_Desk1").SlicerItems("desk1").Selected = True) Then
        cell.Value = strArray(counter)
        counter = counter + 1
   End If
Next cell

For Each cell In Brng
If Not (strArray(counter) = "") And (ActiveWorkbook.SlicerCaches("Slicer_Global_Desk1").SlicerItems("desk2").Selected = True) Then
    cell.Value = strArray(counter)
    counter = counter + 1
End If
Next cell

Call PivotTableRefresh

MsgBox "Updated Successfully"
End Sub

1 个答案:

答案 0 :(得分:0)

我重构了你的代码:

Sub UpdateRisk_Click()
Dim wksSource As Worksheet
Dim wksDest As Worksheet
Dim strArray(0 To 18) As String
Dim Arng As Range
Dim Brng As Range
Dim cell As Range
Dim i As Integer

Set wksSource = ActiveWorkbook.Sheets("By Risk Pivot")
Set wksDest = ActiveWorkbook.Sheets("(NEW) Full Data")

Set Arng = wksDest.Range("AB335,AB358,AB379,AB380,AB382,AB383,AB386,AB391,AB404,AB409,AB410,AB412,AB413,AB423,AB427,AB432,AB438,AB442,AB443,AB444")
Set Brng = wksDest.Range("AB109,AB130,AB151,AB152,AB155,AB157,AB159,AB166,AB178,AB185,AB186,AB187,AB188,AB193,AB197,AB199,AB204,AB206,AB208,AB209")

For i = 0 To 18
    strArray(i) = wksSource.Range("M" & (i + 8))
Next i

If ActiveWorkbook.SlicerCaches("Slicer_Global_Desk1").SlicerItems("desk1").Selected Then
    i = 0
    For Each cell In Arng
        If strArray(i) <> "" Then cell.Value = strArray(i)
        i = i + 1
    Next cell
End If

If ActiveWorkbook.SlicerCaches("Slicer_Global_Desk1").SlicerItems("desk2").Selected Then
    i = 0
    For Each cell In Brng
        If strArray(i) <> "" Then cell.Value = strArray(i)
        i = i + 1
    Next cell
End If

Call PivotTableRefresh

MsgBox "Updated Successfully"

End Sub

一些注意事项:

  1. 仔细检查您的wksDest分配。如果目标工作表位于同一工作簿中,它将起作用。如果它在另一本书中,那么您的代码将无效;
  2. 您的数组包含19个值,但您的范围为20.它们需要同步,否则您将收到VBA错误(“下标超出范围”)