Обновите диапазон, если исходная ячейка не пуста, иначе перейдите к следующему

Кажется, я не могу понять одно условие моего кода. Я также новичок в VBA. Короче говоря, у меня есть slicer на одном листе, который содержит мои значения фильтра, и у меня есть диапазон из 19 ячеек, которые можно обновить с помощью выпадающего списка I, использующего проверку данных.

Когда значение выбрано в ЛЮБОЙ ячейке диапазона на исходном листе (исходный диапазон – M8: M26), мне нужно обновить соответствующую ячейку в диапазоне другой рабочей книги (которая не является непрерывным диапазоном, как в исходной книге ). Например, M8 будет обновлять AB335, когда фильтр находится на столе1, 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 

Я немного переработал ваш код:

 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 («индекс вне диапазона»)
Давайте будем гением компьютера.