使用工作表名称动态填充列答案

【问题标题】：Dynamically populate column with worksheet name使用工作表名称动态填充列
【发布时间】：2015-10-01 19:16:26
【问题描述】：

我需要用工作表的名称填充特定列中的单元格。

我有以下代码用于填充单个单元格：

Sub Worksheet_Name_Plop()
    Cells.WrapText = False ' Disables WordWrap
    [AG2].Value = ActiveSheet.Name
    Columns("AG").Select
    Selection.EntireColumn.AutoFit
End Sub

我遇到的问题是每个工作表可能有 1 到 10,000 多行数据。不确定如何仅填充具有数据的行。

有一个标题行，因此结果从每个工作表的第二行开始很重要。

为了提高效率：我还需要能够跨同一文件的所有工作表执行此操作。

非常感谢任何帮助！

【问题讨论】：

是否有一列将连续数据直到最后一行，例如A列？
抱歉，A 是公平的游戏！

标签： excel vba

【解决方案1】：

9 秒内 1000 万行：

Option Explicit

Public Sub setID1()
    Const FIRST_ROW As Long = 2
    Const COL       As String = "AG"
    Dim ws As Worksheet, lastRow As Long, t As Double, tr As Long

    Application.ScreenUpdating = False: t = Timer
    For Each ws In Application.ActiveWorkbook.Worksheets
        lastRow = ws.UsedRange.Row + ws.UsedRange.Rows.Count - 1

        ws.Range(COL & FIRST_ROW & ":" & COL & lastRow).Value2 = ws.Name
        With ws.Cells(FIRST_ROW, COL)
            .WrapText = False
            .EntireColumn.AutoFit
        End With
        tr = tr + lastRow - FIRST_ROW + 1
    Next
    Debug.Print "setID1 - Sheets: " & Worksheets.Count & _
                       ", Rows: " & tr & ", Duration: " & Timer - t
    Application.ScreenUpdating = True
End Sub

Public Sub setID2()
    Const FIRST_ROW As Long = 2
    Const COL       As String = "AG"
    Dim ws As Worksheet, lastRow As Long, t As Double, tr As Long

    Application.ScreenUpdating = False: t = Timer
    For Each ws In Application.ActiveWorkbook.Worksheets
        lastRow = ws.UsedRange.Row + ws.UsedRange.Rows.Count - 1

        With ws.Cells(FIRST_ROW, COL)
            .Value2 = ws.Name
            .WrapText = False
            .EntireColumn.AutoFit
        End With
        ws.Range(COL & FIRST_ROW & ":" & COL & lastRow).FillDown
        tr = tr + lastRow - FIRST_ROW + 1
    Next
    Debug.Print "setID2 - Sheets: " & Worksheets.Count & _
                       ", Rows: " & tr & ", Duration: " & Timer - t
    Application.ScreenUpdating = True
End Sub

测试：

setID1 - Sheets: 10, Rows: 10000000, Duration: 9.08203125
setID1 - Sheets: 10, Rows: 10000000, Duration: 9.064453125
setID1 - Sheets: 10, Rows: 10000000, Duration: 9.0625

setID2 - Sheets: 10, Rows: 10000000, Duration: 8.580078125
setID2 - Sheets: 10, Rows: 10000000, Duration: 8.58203125
setID2 - Sheets: 10, Rows: 10000000, Duration: 8.56640625

【讨论】：

确实快如闪电！ print stats 注释行是否应该在运行时更新？另外（在测试之前没有看到这个），可以为结果禁用自动换行吗？
我将其更新为包含 .WrapText = False 和一个稍快的替代方案 (.FillDown)。打印统计信息行将在执行时更新，但您必须打开即时窗口：在 VBA 编辑器中 - 查看 -> 即时窗口 (Ctrl+G)
增加了 0.1 秒。标记=P
终于开始阅读代码了 XD HUH。所以with 更慢啊。很高兴知道^_^
@findwindow - 不，with 更快，但在第二个选项中，.FillDown 更快（我必须对此进行测试：两种解决方案都使用with，第一个更改为使用.Value2 = ，每张表有100万条记录）

【解决方案2】：

遍历行并检查一列的数据，然后在该行中写入名称（如果存在）。

Sub Worksheet_Name_Plop()
    Dim lRow As Long
    Dim ws As Excel.Worksheet
    Dim iIndex As Integer

    For iIndex = 1 To ActiveWorkbook.Worksheets.count

        Set ws = Worksheets(iIndex)
        ws.Activate

        'Start at row 2
        lRow = 2

        'Loop through the rows in the worksheet
        Do While lRow <= ws.UsedRange.Rows.count

            'Check if some column has data
            If ws.Range("A" & lRow).Value <> "" Then
                 'Write the worksheet name to column AG of that row
                 ws.Range("AG" & lRow).Value = ws.Name
            End if

            'Increment you counter
            lRow = lRow + 1
            ws.Range("A" & lRow).Activate
        Loop

       Columns("AG").Select
       Selection.EntireColumn.AutoFit

    Next iIndex    

End Sub

【讨论】：

这行得通，可以在工作表中循环观看！
是的，有一些快速的方法来做事，但如果它是一次性的事情或类似的事情，我会选择一个简单的循环。有时更容易看到正在发生的事情，并且对它的工作感到自在。