VBA Excel在多张纸上填写

Question

您好，我无法通过搜索找到问题的答案。

我有多个工作表，并希望在一开始就使用特定字符串的填充类型方法创建一列。

例如，

如果工作表名称包含“Zebra” - 在开头插入一个新列，并在所有单元格中输入“Zebra's”，直到相邻列的最后一个数据点。

我需要为四个不同的工作表执行此操作： 斑马 大象 犀牛 蛇

Here is what I have thus far, I cannot get it to work:

Sub addAnimal()

Dim ws As Worksheet
Dim N As Long

For Each ws In ActiveWorkbook.Worksheets
If ws.Name Like "zebra*" Then

Application.Goto ActiveWorkbook.Sheets(ws.Name).Cells(2, 1)
ActiveCell.EntireColumn.Insert

ActiveCell.Value = "Zebra"

Dim lastRow As Long, lastUsedRow As Long
Dim srcRange As Range, fillRange As Range
With Worksheets(ws.Name)
    lastUsedRow = .Range("A" & .Rows.Count).End(xlUp).Row
    lastRow = .Range("B" & .Rows.Count).End(xlUp).Row
    ' Fill values from A:D all the way down to lastUsedRow

    Set srcRange = .Range("A" & lastUsedRow)
    Set fillRange = .Range("A" & lastRow)

    fillRange.Value = srcRange.Value
End With

End If
Next ws

Answer 1

由于动物数组与工作表名称的集合相比，会有一些重复，但辅助子程序可以消除大部分重复。

Option Explicit

Sub addAnimalMain()
    Dim w As Long, grr As Variant

    grr = Array("Zebra", "Elephant", "Rhino", "Snake")

    For w = 1 To ThisWorkbook.Worksheets.Count
        With ThisWorkbook.Worksheets(w)
            Select Case True
                Case CBool(InStr(1, .Name, grr(0), vbTextCompare))
                    addAnimalHelper ThisWorkbook.Worksheets(w), grr(0)
                Case CBool(InStr(1, .Name, grr(1), vbTextCompare))
                    addAnimalHelper ThisWorkbook.Worksheets(w), grr(1)
                Case CBool(InStr(1, .Name, grr(2), vbTextCompare))
                    addAnimalHelper ThisWorkbook.Worksheets(w), grr(2)
                Case CBool(InStr(1, .Name, grr(3), vbTextCompare))
                    addAnimalHelper ThisWorkbook.Worksheets(w), grr(3)
            End Select
        End With
    Next w
End Sub

Sub addAnimalHelper(ws As Worksheet, grrr As Variant)
    With ws
        .Columns(1).EntireColumn.Insert
        .Range(.Cells(1, "A"), .Cells(.Rows.Count, "B").End(xlUp).Offset(0, -1)) = grrr
    End With
End Sub