[已解决]请问大神为什么D列没有显示对应工作表名称？请帮忙看看

新一

请问大神为什么D列没有显示对应工作表名称？请帮忙看看

最佳答案

月排行榜 / 总排行榜

zjdh

2022-5-11 12:27

这样修改比较好
Sub ayy2()
    Application.ScreenUpdating = False
    Sheet14.Range("A2:D65536").Clear
    For Each sh In Sheets
        If sh.Name <> Sheet14.Name And sh.Name <> Sheet1.Name And sh.Name <> Sheet13.Name Then
            LRow = Sheet14.[C65536].End(3).Row + 1
            With sh
                .Range("A2:C" & .[C65536].End(3).Row).Sort Key1:=.Range("A2:A" & .[C65536].End(3).Row), Order1:=xlAscending, Header:=xlGuess
                ARR = .Range("A2:C" & .[C65536].End(3).Row)
            End With
            If ARR(1, 1) <> "返回目录" Then
                Sheet14.Range("A" & LRow).Resize(UBound(ARR), 3) = ARR
                Sheet14.Range("D" & LRow) = sh.Name
            End If
        End If
        ARR = ""
    Next
    Sheet14.Range("D2:D" & Sheet14.[C65536].End(3).Row).SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
    Sheet14.Range("D2:D" & Sheet14.[C65536].End(3).Row).Value = Sheet14.Range("D2:D" & Sheet14.[C65536].End(3).Row).Value
    Application.ScreenUpdating = True
End Sub

跳转到最佳答案楼层

zjdh

Sub ayy2()
..............
For Each sh In Sheets
    If sh.Name <> Sheet14.Name And sh.Name <> Sheet1.Name And sh.Name <> Sheet13.Name Then
       LRow = Sheet14.[C65536].End(3).Row + 1
       With sh
            .Range("A2:C" & .[C65536].End(3).Row).Sort Key1:=.Range("A2:A" & .[C65536].End(3).Row), Order1:=xlAscending, Header:=xlGuess
            arr = .Range("A2:C" & .[C65536].End(3).Row)
       End With
       Sheet14.Range("a" & LRow).Resize(UBound(arr), 3) = arr
       Sheet14.Range("D" & LRow) = sh.Name
    End If
    arr = ""
Next
.................

zjdh

这样修改比较好
Sub ayy2()
    Application.ScreenUpdating = False
    Sheet14.Range("A2:D65536").Clear
    For Each sh In Sheets
        If sh.Name <> Sheet14.Name And sh.Name <> Sheet1.Name And sh.Name <> Sheet13.Name Then
            LRow = Sheet14.[C65536].End(3).Row + 1
            With sh
                .Range("A2:C" & .[C65536].End(3).Row).Sort Key1:=.Range("A2:A" & .[C65536].End(3).Row), Order1:=xlAscending, Header:=xlGuess
                ARR = .Range("A2:C" & .[C65536].End(3).Row)
            End With
            If ARR(1, 1) <> "返回目录" Then
                Sheet14.Range("A" & LRow).Resize(UBound(ARR), 3) = ARR
                Sheet14.Range("D" & LRow) = sh.Name
            End If
        End If
        ARR = ""
    Next
    Sheet14.Range("D2:D" & Sheet14.[C65536].End(3).Row).SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
    Sheet14.Range("D2:D" & Sheet14.[C65536].End(3).Row).Value = Sheet14.Range("D2:D" & Sheet14.[C65536].End(3).Row).Value
    Application.ScreenUpdating = True
End Sub