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

VBA Excel 在多张纸上向下填充

VBA Excel Fill Down on multiple sheets

excel

vba

autofill