VBA Excel在多张纸上填写

时间:2018-07-06 19:04:16

标签: excel vba autofill

嗨,我无法通过搜索找到问题的答案。

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

例如,

如果工作表名称包含“ 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

1 个答案:

答案 0 :(得分: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