ソースセルが空白でない場合は範囲​​を更新し、それ以外の場合は次へ進みます

Question

私のコードの条件を理解できないようです。私はVBAの初心者です。要するに、私はフィルタ値を含む1つのワークシート上のスライサーを持っており、データ検証を使用してセットアップするドロップダウンリストで更新できる19個のセルの範囲があります。

ソースワークシート（ソース範囲はM8：M26）の範囲のANYセルで値が選択されている場合、別のワークブックの範囲内の対応するセルを更新する必要があります。ソースブックにあります）。例えば、M8は、フィルターがdesk1にあるときに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 

Answer 1

私は少しあなたのコードをリファクタリング：

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個の値が含まれていますが、あなたの範囲は、彼らがそうでなければ、VBAエラー（「範囲外の添字」）を取得します、同期する必要が20を持っている