Question

嗨，我在vba上很新，所以请不要拍我的代码:-)。我有一套补偿代码。我想通过使用越来越多的代码名称来简化此代码。我无法让它运行。有人可以帮助我在路上实现这一目标。在我尝试的下面。第二个块现在是代码的一部分（它是相同代码的40个块只增加了数量）

Sub sheet41()
Dim i As Integer
Dim chkname As Integer
chkname = "SheetCheckBox" & i
i = 1
Do
  i = i + 1
  If chkname.Visible = False Then Exit Sub
  If chkname.value = True Then
    Sheets("Item_" & i).Select
    Call Finalize
  End If
Loop Until i = ThisWorkbook.Worksheets.Count
End Sub

这是旧代码：

Sub Sheet1()
If SheetCheckBox1.Visible = False Then Exit Sub
If SheetCheckBox1.value = True Then
  Sheets("Item_1").Select
  Call Finalize
End If
End Sub

Sub Sheet2()
If SheetCheckBox2.Visible = False Then Exit Sub
If SheetCheckBox2.value = True Then
  Sheets("Item_2").Select
  Call Finalize
End If
End Sub

Sub Sheet3()
If SheetCheckBox3.Visible = False Then Exit Sub
If SheetCheckBox3.value = True Then
  Sheets("Item_3").Select
  Call Finalize
End If
End Sub

正如你所知，这应该是可以清理我的。

Answer 1

这应该这样做。如果未在工作表上调用finalize，则会将原因打印到立即窗口。

Sub ProcessWorkSheets()

    Dim check As MSForms.CHECKBOX
    Dim i As Integer
    For i = 1 To Worksheets.Count

        On Error Resume Next
        Set check = Worksheets(i).OLEObjects("SheetCheckBox" & i).Object
        On Error GoTo 0
        If check Is Nothing Then
            Debug.Print Worksheets(i).Name; " - Checkbox not found"
        Else
            If check.Visible And check.Value Then
                Worksheets(i).Select
                Call Finalize
            Else
                Debug.Print Worksheets(i).Name; " - Checkbox", "Visible", check.Visible, "Value:", check.Value
            End If
        End If

        Set check = Nothing
    Next

End Sub

Answer 2

如果工作表上的复选框是ActiveX控件，您可以使用它来访问复选框：

Sheets("sheet1").OLEObjects("chkTest").Object

如果您想更改复选框的值，请按以下方式使用：

    Sheets("sheet1").OLEObjects("chkTest").Object.Value = True

现在将"sheet1"替换为您的实际工作表名称，并将"chkTest"更改为您的字符串chkname

所以你的完整代码应该是这样的：

Dim i As Integer
Dim sheetname As String
Dim chkname As String

sheetname = "YOUR SHEETNAME HERE"

For i = 1 To ThisWorkbook.Worksheets.Count Step 1

    chkname = "SheetCheckBox" & i

    If Sheets(sheetname).OLEObjects(chkname).Object.Visible = False Then Exit Sub

    If Sheets(sheetname).OLEObjects(chkname).Object.Value = True Then

        Sheets("Item_" & i).Select
        Call Finalize
    End If
Next i

用循环简化代码

2 个答案: