Код Excel VBA для ввода значений в прямоугольники

Question

Разработка VBA для создания значений в трех прямоугольниках и определения пересечения чисел.

Пример кода для создания кода.

Public Sub call_shareRectangles() 
Call shareRectangles("inputRange", "C1") 
End Sub 
Private Sub shareRectangles(referenceRange As String, initCell As String) 
Dim R As Range 
Dim rangeIterator As Integer 
Dim countRange As Integer 
Dim move As Integer 
Set R = Names(referenceRange).RefersToRange 
rangeIterator = 1 
countRange = Range(referenceRange).Count 

move = 0 
While (rangeIterator <= countRange) 
For i = 1 To R(rangeIterator) 
For j = 1 To R(rangeIterator) 
Range(initCell).Offset(move + i - 1, j - 1) = R(rangeIterator) 
Next j 
Next i 
move = move + R(rangeIterator) 
rangeIterator = rangeIterator + 1 

Wend 

End Sub 

Решение прямоугольниками необходимо

Answer 1

Этот код:

Dim c As Range 
    With Range("B2:G7") 
     .BorderAround Weight:=xlMedium, Color:=rgbCoral 
     For Each c In .Cells: c.value = c.value + 1: Next 
    End With 
    With Range("C4:E12") 
     .BorderAround Weight:=xlMedium, Color:=rgbDarkViolet 
     For Each c In .Cells: c.value = c.value + 1: Next 
    End With 
    With Range("D3:I10") 
     .BorderAround Weight:=xlMedium, Color:=rgbGray 
     For Each c In .Cells: c.value = c.value + 1: Next 
    End With 

будет производить этот результат: