在 VBA 中排序数据不执行

Question

我试图将第一个工作簿中的工作表 RLDSht 复制到我的第二个工作簿中。然后它被称为 USSht 工作表。 我想在此 USSht 中对数据进行排序，但即使在我激活工作表时它也不会执行。这是代码：

Public WorkbookName As String
Public WorkbookVV As Workbook
Public RLDSht As Worksheet
Public USSub As Worksheet
Public NoGrey As Worksheet
Public ws As Worksheet

Sub SelectWorkbook()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.AskToUpdateLinks = False

WorkbookName = Application.GetOpenFilename("Excel files (*.xlsm), *xlsm", 1, "Select your workbook", , False)
If WorkbookName <> "False" Then
    Set WorkbookVV = Workbooks.Open(WorkbookName)
    
    For Each ws In WorkbookVV.Sheets
        If Not ws.Cells.Find("Data type") Is Nothing Then
            RLDShtExist = True
            Set RLDSht = ws
            Exit For
        End If
    Next ws
    
    If RLDShtExist = False Then
        MsgBox "Erreur: Le workbook sélectionné ne contient pas d'onglet Regulatory Line Data"
        WorkbookName = ""
        Exit Sub
    End If
Else
    Exit Sub
End If

If RLDSht.FilterMode Then RLDSht.ShowAllData

RLDSht.Copy after:=Workbooks("US Submission table.xlsm").Worksheets("US Submission Table")
Set Ussht = ActiveSheet

With Ussht
    If .FilterMode Then .ShowAllData
    lR = .Cells(Rows.Count, 1).End(xlUp).Row
    'last column
    lC = .Cells(lR, Columns.Count).End(xlToLeft).Column
    'first row
    fR = .Cells(lR, 1).End(xlUp).Row
    
    Set cdt = Range(.Cells(fR, 1), .Cells(fR, lC)).Find("Data type")
    If Not cdt Is Nothing Then
        c = cdt.Column
    Else
        MsgBox "La colonne Data type n'est pas présenté dans ce tab RLD"
    End If
    


End With
Ussht.Activate
Ussht.Range(Cells(fR, 1), Cells(fR, lC)).Sort Key1:=Range("A12"), Order1:=xlDescending

End Sub

我也尝试了不同范围的参考细胞，也不行

Ussht.Range(Cells(fR, 1), Cells(fR, lC)).Sort Key1:=Range(Cells(fR, 1), Cells(fR, 1)), Order1:=xlDescending

我也尝试语法 Key/order 而不是 Key1/Order1.

它只有在我尝试像这样非常精确的东西时才有效：

Ussht.Range("A12:AB1740").Sort Key1:=Range("A12"), Order1:=xlDescending, Header:=xlYes

Range(Cells(fR, 1), Cells(fR, lC))

有什么问题吗？

Answer 1

导入工作表

Option Explicit

Sub ImportWorksheet()

    Dim sFilePath: sFilePath = Application.GetOpenFilename( _
        "Excel files (*.xlsm), *xlsm", , "Select your workbook")
    If VarType(sFilePath) = vbBoolean Then Exit Sub ' canceled
    
    Dim swb As Workbook: Set swb = Workbooks.Open(sFilePath)
    
    Dim sws As Worksheet, shCell As Range
    
    For Each sws In swb.Worksheets
        If sws.FilterMode Then sws.ShowAllData
        Set shCell = sws.UsedRange.Find( _
            "Data Type", , xlFormulas, xlWhole, xlByRows)
        If Not shCell Is Nothing Then Exit For
    Next sws
    
    If sws Is Nothing Then
        MsgBox "Erreur: Le workbook sélectionné ne contient " _
            & "pas d'onglet Regulatory Line Data", vbExclamation
        Exit Sub
    End If
    
    ' If this is the workbook containing this code, use 'Set dwb = Thisworkbook'
    Dim dwb As Workbook: Set dwb = Workbooks("US Submission table.xlsm")
    Dim aws As Worksheet: Set aws = dwb.Sheets("US Submission Table")
    
    sws.Copy After:=aws
    
    Dim hAddress As String: hAddress = shCell.Address
    swb.Close SaveChanges:=False
    
    Dim dws As Worksheet: Set dws = aws.Next
    
    Dim dhCell As Range: Set dhCell = dws.Range(hAddress) ' Data Type
    Dim dfRow As Long: dfRow = dhCell.Row
    
    Dim dfCol As Long, dlCol As Long, dlrow As Long
    
    With dws.UsedRange
        dfCol = .Column
        dlCol = .Columns(.Columns.Count).Column
        dlrow = .Rows(.Rows.Count).Row
    End With
        
    Dim drg As Range
    Set drg = dws.Range(dws.Cells(dfRow, dfCol), dws.Cells(dlrow, dlCol))

    drg.Sort drg.Columns(1), xlDescending, , , , , , xlYes

    ' Continue...

End Sub