Question

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

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

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

我遇到的麻烦是每个工作表可能有一到10,000多行数据。不确定如何只填充有数据的行。

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

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

非常感谢任何帮助！

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

试验：

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

使用工作表名称

2 个答案: