时间戳

首页 > 解决方案 > 根据另一个工作表中的值在多个单元格中绘制圆圈

excel - 根据另一个工作表中的值在多个单元格中绘制圆圈

问题描述

表 1 表 2

表 1..................................表 2

我目前正在尝试根据（表 2）中的单元格值制作一个在（表 1）中绘制圆圈的宏。

假设从（表 2）中查找是或否，然后根据（表 1）中的单元格值为每一行圈出是或否

对我来说，目前的结果是所有圆圈都只绘制在（表 1）中的（1）单元格中，然后选择下一个单元格。

删除For i = 0 To 4和If函数会导致在（表 1）中两个范围的所有单元格中绘制圆圈。

Sub DrawCricles()
Dim Arng As Range, drawRng As Range, infoRng As Range, YesRng As Range, NoRng As Range, 
Set drawRng = Application.Selection
Set infoRng= Worksheets("Sheet2").Range("A1:A5") 'All the values in this range is either Yes/No
Set YesRng = Worksheets("Sheet1").Range("A1,A2,A3,A4,A5") 'All the values in this range is Yes
Set NoRng = Worksheets("Sheet1").Range("C1,C2,C3,C4,C5") 'All the values in this range is No

For i = 0 To 4
    NoRng(i).Select
    If infoRng(i).Value = "NO" Then
        NoRng(i).Select
        For Each Arng In drawRng.Areas
            With Arng
            x = Arng.Height * 0.1
            y = Arng.Width * 0.1
                Application.Worksheets("Sheet1").Ovals.Add Top:=.Top - x, Left:=.Left - y, _
                Height:=.Height + 2 * x, Width:=.Width - 5 * y
                With Application.Worksheets("Sheet1").Ovals(Worksheets("Sheet1").Ovals.Count)
                    .Interior.ColorIndex = xlNone
                    .ShapeRange.Line.Weight = 1.25
                End With
            End With
        Next
    Else
        YesRng(i).Select 
        For Each Arng In drawRng.Areas
            With Arng
            x = Arng.Height * 0.1
            y = Arng.Width * 0.1
                Application.Worksheets("Sheet1").Ovals.Add Top:=.Top - x, Left:=.Left + y * 4, _
                Height:=.Height + 2 * x, Width:=.Width - 3 * y
                With Application.Worksheets("Sheet1").Ovals(Worksheets("Sheet1").Ovals.Count)
                    .Interior.ColorIndex = xlNone
                    .ShapeRange.Line.Weight = 1.25
                End With
            End With
        Next
    End If
Next

标签： excelvbacelldrawshapes

解决方案

测试：

Sub DrawCircles()
    Dim c As Range, infoRng As Range, YesNoRng As Range, i As Long, yn

    Set infoRng = Worksheets("Sheet2").Range("A1:A5")
    Set YesNoRng = Worksheets("Sheet1").Range("A1:B5")  'both columns...
    yn = UCase(infoRng.Cells(i).Value)
    For i = 1 To infoRng.Cells.Count    'index from 1 not zero
        'corresponding Y/N cell - choose based on Y/N
        yn = UCase(infoRng.Cells(i).Value)
        With YesNoRng.Cells(i, IIf(yn = "NO", 2, 1))
            ' .Parent is the Worksheet
            ' Ovals.Add() returns the added shape, so you can use it directly here
            With .Parent.Ovals.Add(Top:=.Top + 3, Left:=.Left + 3, _
                            Height:=.Height - 6, Width:=.Width - 6)

                .Interior.ColorIndex = xlNone
                .ShapeRange.Line.Weight = 1.25
            
            End With
        End With
    Next i
End Sub

推荐阅读