Question

我在Excel中运行一些VBa代码，根据工作表名称列表更新多个工作表。

Sub Test()

Dim ArrayOne As Variant
ArrayOne = ActiveSheet.Range("A8:A10")

Dim sheetsArray As Sheets
Set sheetsArray = ActiveWorkbook.Sheets(ArrayOne)

Dim target As Range
Dim sheetObject As Worksheet

' change value of range 'a1' on each sheet from sheetsArray
For Each sheetObject In sheetsArray
    Set target = sheetObject.Range("A1")
    target.Value = "Test"
Next sheetObject
End Sub

这是我的代码，但不幸的是它出现了错误：在以下代码行中键入Mismatch

Set sheetsArray = ActiveWorkbook.Sheets(ArrayOne)

Answer 1

我理解您要根据Excel范围（A8：A10）中包含的工作表列表更新每个工作表中的相同单元格。

请尝试以下代码：

Public Sub test()
  Dim wks As Worksheet
  Dim WksCell As Range

  ' Turn on inline Error Handling
  On Error Resume Next

  ' Look at each cell within the range and obtain worksheet names
  For Each WksCell In ActiveSheet.Range("A8:A10").Cells

    ' Attempt to reference the worksheet using this name
    Set wks = Excel.Worksheets(WksCell.Value)

    ' Check if a "SubScript out of range" error occurred
    ' If so, it indicates that the sheet name does not exist
    If Err.Number = 9 Then
      ' Set its style to Bad and move on
      WksCell.Style = "Bad"
      Err.Clear
    Else
      ' For each worksheet, execute our logic
      wks.Range("A1").Value = "Testing"
    End If

    ' If any other error occurred, report it to the user and exit
    If Err.Number <> 0 And Err.Number <> 9 Then
      MsgBox "An error has occurred. Error #" & Err.Number & vbCr & _ 
              Err.Description, vbCritical, "Error Encountered"
      Set wks = Nothing
      Exit For
    End If

  Next
  ' Return to normal error handling
  On Error GoTo 0
  Set wks = Nothing
End Sub

如果您想在宏中使用它，那么您可以更改行

For Each WksCell In ActiveSheet.Range("A8:A10").Cells

到

For Each WksCell In Excel.Selection

将使用您当前的选择作为工作表列表。使它更具活力。

希望有所帮助。

在查询上键入不匹配以从列表创建数组

1 个答案: