用工作表名称dynamic填充列

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

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

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

我遇到的麻烦是每个工作表可能有一到一万行以上的数据。 不知道如何填充只有有数据的行。

有一个标题行，所以重要的是结果从每个工作表的第二行开始。

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

任何援助非常感谢！

Answer 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 

---

testing：

 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 

Answer 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