Excel If Else 语句用于复制带有复选框的数据

Question

我想设置一些代码来复制带有复选框的单元格

我有 30 个复选框

我复制了下面的代码并修改了 30 次

这无疑是多余的

每个复选框在一行，它将复制的数据在同一行

当复选框被点击时，下一个单元格中的行数据将被复制并移动到其他地方

这些数据将被转储到同一个工作表中的某处

我尝试创建 elseif 语句，不幸的是它们不起作用

If ThisWorkbook.Worksheets(1).Shapes("Check Box 2").OLEFormat.Object.Value = 1 Then
     Range("f2").Select
     Selection.Cut
     Sheets("Sheet1").Select
     Range("f15").Select
     ActiveSheet.Paste
     Range("f15").Select
     Selection.Insert Shift:=xlDown    
     End If
     End Sub

If ThisWorkbook.Worksheets(1).Shapes("Check Box 3").OLEFormat.Object.Value = 1 Then
     Range("f3").Select
     Selection.Cut
     Sheets("Sheet1").Select
     Range("f15").Select
     ActiveSheet.Paste
     Range("f15").Select
     Selection.Insert Shift:=xlDown    
     End If
     End Sub

If ThisWorkbook.Worksheets(1).Shapes("Check Box 4").OLEFormat.Object.Value = 1 Then
     Range("f4").Select
     Selection.Cut
     Sheets("Sheet1").Select
     Range("f15").Select
     ActiveSheet.Paste
     Range("f15").Select
     Selection.Insert Shift:=xlDown    
     End If
     End Sub

如您所见，这是非常重复的

关于如何编写此代码使其类似于嵌套 if 语句的任何建议

如果复选框 1 为真，请执行此操作 如果复选框 2 为真，请执行此操作 等等等等

[IMG]http://i44.tinypic.com/2db78dj.jpg[/IMG]

请指教谢谢

Answer 1

在不了解工作簿结构的情况下，这是我能想到的最好的方法。复选框和需要操作的单元格之间可能存在某种“关系”，这可以让您使用公式或其他逻辑来确定要剪切/粘贴的单元格，而不是依赖于If/Then 或 Case 逻辑。

Sub Test()

Dim cb As Shape
Dim cutRange As Range
'## The destination doesn't change, so we put this outside the loop
'    also make it a constant value:
Cosnt destRange As String = "F15"

'## Now, iterate over each checkbox control in the sheet:
For Each cb In ActiveSheet.Shapes
    '## Make sure the shape is an xlCheckBox AND value = True/checked
    If cb.FormControlType = xlCheckBox And cb.OLEFormat.Object.Value = 1 Then
        '## Assign the cutRange based on the CheckBox name
        Select Case cb.Name
            Case "Check Box 2"
                Set cutRange = Range("F3")
            Case "Check Box 3"
                Set cutRange = Range("F4")
            Case "Check Box 4"
                Set cutRange = Range("F5")
            'etc.

            '## You can add as many Case values as you need
        End Select

        '## One statement cuts & inserts:
        cutRange.Cut Range(destRange)
        Range(destRange).Insert Shift:=xlDown

    End If
Next
End Sub