excel VBA中的排序数据不执行

zc0qhyus  于 2023-03-20  发布在  其他
关注(0)|答案(1)|浏览(208)

我试图将第一个工作簿中的工作表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语法,而不是Key 1/Order 1。
只有当我尝试像这样精确的东西时它才起作用:

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

请问Range(Cells(fR, 1), Cells(fR, lC))有什么问题?

hgqdbh6s

hgqdbh6s1#

导入工作表

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

相关问题