我的代碼在大多數時間都有效，但是

我的代碼幾乎可以一直工作，但有些時候它決定沒有任何理由的bug。（它沒有顯示任何錯誤信息，它只是不做它應該做的事情，當它分類時，有時會複製其他行的信息，但它應該全部是空的）

我的程序基本上是自動在同一工作表中自動排序兩個堆疊的表格

CODE：

Option Explicit 

Sub Sorting() 

' Keyboard Shortcut: Ctrl+m 
' 
'******************************* Define variables for the data that I want to store for later use 
Dim MyDataFirstCell 
Dim MyDataLastCell 
Dim MySortCellStart 
Dim MySortCellEnd 

Dim MyDataFirstCell2 
Dim MyDataLastCell2 
Dim MySortCellStart2 
Dim MySortCellEnd2 

'************************** Establish the Data Area 
    ActiveSheet.Range("B1").Select 
    'Next Non Blank Cell down 
    ActiveCell.Offset(1, 0).Select 
    Do While IsEmpty(ActiveCell) 
    DoEvents 
    ActiveCell.Offset(1, 0).Select 
    Loop 

    ActiveCell.Offset(1, 0).Select 

    DoEvents 
    MyDataFirstCell = ActiveCell.Address 'Get the first cell address of Data Area 

    Selection.End(xlDown).Select 'Get to Bottom Row of the data 
    Selection.End(xlToRight).Select 'Get to the last Column and data cell by heading to the righthand end 
    Selection.End(xlToRight).Select 
    ActiveCell.Offset(-1, 0).Select ' Select the correct last cell 
    MyDataLastCell = ActiveCell.Address 'Get the Cell address of the last cell of my data area 

'************************** Establish the Sort column first and last data points. 
    ActiveSheet.Range("B1").Select 
    'Next Non Blank Cell down 
    ActiveCell.Offset(1, 0).Select 
    Do While IsEmpty(ActiveCell) 
    DoEvents 
    ActiveCell.Offset(1, 0).Select 
    Loop 

    ActiveCell.Offset(1, 0).Select 'Get to first cell of data sort Column (Example Col 'R' Row 2 becuase Row 1 contains the header) 
    DoEvents 
    MySortCellStart = ActiveCell.Address 'Get the Cell address of the first cell of my data sort Column 
    Selection.End(xlDown).Select 'Get to the bottom Row of data 
    ActiveCell.Offset(-1, 0).Select 
    MySortCellEnd = ActiveCell.Address 'Get the Cell address of the last cell of my sort Column 

'************************** Start the sort by specifying sort area and columns 
    ActiveSheet.Sort.SortFields.Clear 
    ActiveSheet.Sort.SortFields.Add _ 
    Key:=Range(MySortCellStart & ":" & MySortCellEnd), SortOn:=xlSortOnValues, Order:=xlAscending, _ 
    DataOption:=xlSortNormal 
    With ActiveSheet.Sort 
    .SetRange Range(MyDataFirstCell & ":" & MyDataLastCell) 
    .Header = xlNo 
    .MatchCase = False 
    .Orientation = xlTopToBottom 
    .SortMethod = xlPinYin 
    .Apply 
    End With 

    'Second sorting 
    '************************** Establish the Data Area 
    ActiveSheet.Range("B1").Select 
    'Next Non Blank Cell down 
    ActiveCell.Offset(1, 0).Select 
    Do While IsEmpty(ActiveCell) 
    DoEvents 
    ActiveCell.Offset(1, 0).Select 
    Loop 

    'Next Blank Cell down 
    ActiveCell.Offset(1, 0).Select 
    Do While Not IsEmpty(ActiveCell) 
    DoEvents 
    ActiveCell.Offset(1, 0).Select 
    Loop 

    'Next Non Blank Cell down 
    ActiveCell.Offset(1, 0).Select 
    Do While IsEmpty(ActiveCell) 
    DoEvents 
    ActiveCell.Offset(1, 0).Select 
    Loop 

    DoEvents 
    ActiveCell.Offset(1, 0).Select 

    MyDataFirstCell2 = ActiveCell.Address 'Get the first cell address of Data Area 

    Selection.End(xlDown).Select 'Get to Bottom Row of the data 
    Selection.End(xlToRight).Select 'Get to the last Column and data cell by heading to the righthand end 
    Selection.End(xlToRight).Select 
    ActiveCell.Offset(-1, 0).Select ' Select the correct last cell 
    MyDataLastCell2 = ActiveCell.Address 'Get the Cell address of the last cell of my data area 

'************************** Establish the Sort column first and last data points. 
    ActiveSheet.Range("B1").Select 
    'Next Non Blank Cell down 
    ActiveCell.Offset(1, 0).Select 
    Do While IsEmpty(ActiveCell) 
    ActiveCell.Offset(1, 0).Select 
    Loop 

'Next Blank Cell down 
    ActiveCell.Offset(1, 0).Select 
    Do While Not IsEmpty(ActiveCell) 
    ActiveCell.Offset(1, 0).Select 
    Loop 

'Next Non Blank Cell down 
    ActiveCell.Offset(1, 0).Select 
    Do While IsEmpty(ActiveCell) 
    ActiveCell.Offset(1, 0).Select 
    Loop 


    ActiveCell.Offset(1, 0).Select 'Get to first cell of data sort Column (Example Col 'R' Row 2 becuase Row 1 contains the header) 
    MySortCellStart2 = ActiveCell.Address 'Get the Cell address of the first cell of my data sort Column 
    Selection.End(xlDown).Select 'Get to the bottom Row of data 
    ActiveCell.Offset(-1, 0).Select 
    MySortCellEnd2 = ActiveCell.Address 'Get the Cell address of the last cell of my sort Column 

'************************** Start the sort by specifying sort area and columns 
    ActiveSheet.Sort.SortFields.Clear 
    ActiveSheet.Sort.SortFields.Add _ 
    Key:=Range(MySortCellStart2 & ":" & MySortCellEnd2), SortOn:=xlSortOnValues, Order:=xlAscending, _ 
    DataOption:=xlSortNormal 
    With ActiveSheet.Sort 
    .SetRange Range(MyDataFirstCell2 & ":" & MyDataLastCell2) 
    .Header = xlNo 
    .MatchCase = False 
    .Orientation = xlTopToBottom 
    .SortMethod = xlPinYin 
    .Apply 
    End With 

'Select first element of first table 
    DoEvents 
    ActiveSheet.Range("F1").Select 
    Range(MyDataFirstCell).Select 

End Sub

我在用VBA編寫新的，我知道像C和LPC的語言，但我從來沒有學過VBA。所以，如何解決問題或改進我的代碼的任何幫助，我都是關於它的。

非常感謝您的耐心，關注和幫助。

來源

2016-09-28 Lucas Poloni Cordeiro

您可以通過[避免使用'.Select'（http://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel縮短代碼，一噸-vba-宏）。我沒有真正查看你的代碼，但使用'.Select'可能會導致意外的結果。當它出錯時，點擊「調試」 - 錯誤發生在哪一行上，它有什麼錯誤？ – BruceWayne

失敗時會得到什麼錯誤信息？ –

@BruceWayne @BruceWayne @BruceWayne @BruceWayne這是問題所在，它不會顯示任何錯誤，它只是不做它應該做的事情有時 –

你的代碼真的很難遵循 - 有一個很好的機會在某個點選擇錯誤的單元格，然後你試圖對單元格執行非法操作。

下面的代碼將按第二列對工作簿中的所有區域進行排序（如果任何區域沒有第二列，則可能會失敗）。

最重要的一點（比我在代碼中突出的重要位除外）
Set rCurrentRegion = - 這需要是你排序範圍內的參考。
它可以使用類似
Set rCurrentRegion = ThisWorkbook.Worksheets("Sheet1").Range("A10:Z5000")手動設置。
在你的代碼中，它將是
Set rCurrentRegion = Range(MySortCellStart2 & ":" & MySortCellEnd2)（儘管你錯過了工作表參考 - 否則它將作用於activesheet）。

Sub Test() 

    Dim Regions As Variant 
    Dim x As Long 
    Dim rCurrentRegion As Range 

    'Get a list of all the regions in your workbook as the range 
    'in your code doesn't appear to be in a static location. 
    'This will return an array of cell addresses. 
    'e.g. Regions(0) = "Sheet1!A4:P16" 
    '  Regions(1) = "Sheet1!A21:L33" 
    Regions = FindRegionsInWorkbook(ThisWorkbook) 

    'Work through each element in the Regions array. 
    For x = LBound(Regions) To UBound(Regions) 

     'Turn the array element into a Range object. 
     Set rCurrentRegion = Range(Regions(x)) 

     ''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
     'THIS IS THE IMPORTANT BIT       ' 
     'Sorting without selecting - the range that was  ' 
     'identified in the previous line of code is acted on. ' 
     ''''''''''''''''''''''''''''''''''''''''''''''''''''''' 

     'The Parent of the range is the worksheet object. 
     With rCurrentRegion.Parent 
      .Sort.SortFields.Clear 
      'We're going to sort by the second column in the range. 
      .Sort.SortFields.Add _ 
       Key:=rCurrentRegion.Columns(2), _ 
       SortOn:=xlSortOnValues, _ 
       Order:=xlAscending, _ 
       DataOption:=xlSortNormal 
      'Apply the sort. 
      With .Sort 
       .SetRange rCurrentRegion 
       .Header = xlYes 
       .MatchCase = False 
       .Orientation = xlTopToBottom 
       .SortMethod = xlPinYin 
       .Apply 
      End With 
     End With 

    Next x 

End Sub 

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
'This function returns all the separate regions in your workbook. ' 
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
Public Function FindRegionsInWorkbook(wrkBk As Workbook) As Variant 
    Dim ws As Worksheet, rRegion As Range, sRegion As String, sCheck As String 
    Dim sAddys As String, arrAddys() As String, aRegions() As Variant 
    Dim iCnt As Long, i As Long, j As Long 
    '//Cycle through each worksheet in workbook. 
    j = 0 
    For Each ws In wrkBk.Worksheets 
     sAddys = vbNullString 
     sRegion = vbNullString 
     On Error Resume Next 
     '//Find all ranges of constant & formula valies in worksheet. 
     sAddys = ws.Cells.SpecialCells(xlCellTypeConstants, 23).Address(0, 0) & "," 
     sAddys = sAddys & ws.Cells.SpecialCells(xlCellTypeFormulas, 23).Address(0, 0) 
     If Right(sAddys, 1) = "," Then sAddys = Left(sAddys, Len(sAddys) - 1) 
     On Error GoTo 0 
     If sAddys = vbNullString Then GoTo SkipWs 
     '//Put each seperate range into an array. 
     If InStr(1, sAddys, ",") = 0 Then 
      ReDim arrAddys(0 To 0) 
      arrAddys(0) = "'" & ws.Name & "'!" & sAddys 
     Else 
      arrAddys = Split(sAddys, ",") 
      For i = LBound(arrAddys) To UBound(arrAddys) 
       arrAddys(i) = "'" & ws.Name & "'!" & arrAddys(i) 
      Next i 
     End If 
     '//Place region that range sits in into sRegion (if not already in there). 
     For i = LBound(arrAddys) To UBound(arrAddys) 
      If InStr(1, sRegion, ws.Range(arrAddys(i)).CurrentRegion.Address(0, 0)) = 0 Then 
       sRegion = sRegion & ws.Range(arrAddys(i)).CurrentRegion.Address(0, 0) & "," '*** no sheet 
       sCheck = Right(arrAddys(i), Len(arrAddys(i)) - InStr(1, arrAddys(i), "!")) 
       ReDim Preserve aRegions(0 To j) 
       aRegions(j) = Left(arrAddys(i), InStr(1, arrAddys(i), "!") - 1) & "!" & ws.Range(sCheck).CurrentRegion.Address(0, 0) 
       j = j + 1 
      End If 
     Next i 
SkipWs: 
    Next ws 
    On Error GoTo ErrHandle 
    FindRegionsInWorkbook = aRegions 
    Exit Function 
ErrHandle: 
    'things you might want done if no lists were found... 
End Function

來源

2016-09-28 15:08:30

我的代碼在大多數時間都有效，但是

回答

相關問題