我想对一个多维数组进行排序，该数组在第一列中包含名称值，在第二列中包含日期/时间。我想从Microsoft Excel电子表格中检索值并通过Visual Basic for Applications执行所有操作，然后将其放在另一个电子表格中并执行条件格式设置。整个数组不会进入新的电子表格。
Sub ListPlatformSyncDates()
'===============================================================================================
'Description: Selects the entire row for all selected cells and then hides them.
'Originally written by: Troy Pilewski
'Date: 2015-05-12
'Modified by: Troy Pilewski
'Modified on: 2016-02-01
'===============================================================================================
'Declaration of variables for use during the procedure
Dim wsSheet As Worksheet
Dim lngLastRow As Long, lngLastNOC As Long, lngLastShip As Long, RowTotal As Long
'Changes the state of the application events
Call TOGGLEEVENTS(False)
'Exits the procedure is no workbook is open
If ActiveSheet Is Nothing Then
Exit Sub
End If
'Sets the sheets the variables
Set wsSheet = ActiveSheet
'Determine the last row with values
lngLastRow = wsSheet.Range("A:L").Find( _
What:="*", _
After:=wsSheet.Range("A1"), _
LookAt:=xlByRows, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious _
).Row
lngLastNOC = wsSheet.Range("A1:A" & lngLastRow - 15).Find( _
What:="_", _
After:=wsSheet.Range("A1"), _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious _
).Row
'Debug.Print lngLastRow
'Debug.Print lngLastNOC
'Set the last row of the reported platforms
lngLastShip = lngLastRow - 15
RowTotal = lngLastShip - lngLastNOC
On Error Resume Next
'Declares variables for use with the chooser form
Dim ClassificationLevel(1) As String, ClassificationSelection As String
'Assigns the two classifications to the String Array
ClassificationLevel(0) = "Non-Secure Internet Protocol Router Network"
ClassificationLevel(1) = "Secure Internet Protocol Router Network"
'Prompts the user to select a classification
ClassificationSelection = GetChoiceFromChooserForm(ClassificationLevel(), "Classification Level")
Select Case ClassificationSelection
Dim loopCounter As Long, CharPos As Long
Dim ship As Range
Dim FullShipName, strFullShipName As String, SplitShipName, NamePart
Case "Non-Secure Internet Protocol Router Network"
ReDim NTable(RowTotal, 1) As String
loopCounter = lngLastNOC + 1
For Each ship In Range("B" & loopCounter & ":B" & lngLastShip)
With Application
.DisplayStatusBar = True
.StatusBar = "Working with the " & Range("B" & loopCounter)
End With
FullShipName = Split(Replace(WorksheetFunction.Clean(ship), Chr(160), Chr(32)), Chr(32))
If UBound(FullShipName) > 0 Then
If Left(FullShipName, 2) = "US" Or Left(FullShipName, 2) = "PC" Then
FullShipName(0) = Chr(32)
End If
strFullShipName = Trim(Join(FullShipName, Chr(32)))
If InStr(strFullShipName, Chr(46)) > 0 Then
SplitShipName = Split(strFullShipName, Chr(32))
For Each NamePart In SplitShipName
If InStr(NamePart, Chr(46)) > 0 Then
NamePart = UCase(NamePart)
End If
Next
strFullShipName = Trim(Join(SplitShipName, Chr(32)))
' Debug.Print strFullShipName
If InStr(strFullShipName, Chr(40)) > 0 Then
CharPos = InStr(strFullShipName, Chr(40))
strFullShipName = Left(strFullShipName, CharPos - 1) & Chr(33) & Mid(strFullShipName, CharPos)
SplitShipName = Split(strFullShipName, Chr(33))
If UBound(SplitShipName) > 0 Then
SplitShipName(1) = UCase(SplitShipName(1))
End If
strFullShipName = Trim(Join(SplitShipName))
' Debug.Print strFullShipName
End If
NTable(loopCounter - 13, 0) = strFullShipName
NTable(loopCounter - 13, 1) = Range("C" & loopCounter)
ElseIf InStr(strFullShipName, Chr(40)) > 0 Then
CharPos = InStr(strFullShipName, Chr(40))
strFullShipName = Left(strFullShipName, CharPos - 1) & Chr(33) & Mid(strFullShipName, CharPos)
SplitShipName = Split(strFullShipName, Chr(33))
If UBound(SplitShipName) > 0 Then
SplitShipName(1) = UCase(SplitShipName(1))
End If
strFullShipName = Trim(Join(SplitShipName))
' Debug.Print strFullShipName
NTable(loopCounter - 13, 0) = strFullShipName
NTable(loopCounter - 13, 1) = Range("C" & loopCounter)
Else
strFullShipName = StrConv(strFullShipName, vbProperCase)
' Debug.Print strFullShipName
NTable(loopCounter - 13, 0) = strFullShipName
NTable(loopCounter - 13, 1) = Range("C" & loopCounter)
End If
End If
Debug.Print NTable(loopCounter - 13, 0) & Chr(32) & NTable(loopCounter - 13, 1)
loopCounter = loopCounter + 1
Next ship
Case "Secure Internet Protocol Router Network"
ReDim STable(RowTotal, 1) As String
loopCounter = lngLastNOC + 1
For Each ship In Range("B" & loopCounter & ":B" & lngLastShip)
With Application
.DisplayStatusBar = True
.StatusBar = "Working with the " & Range("B" & loopCounter)
End With
FullShipName = Split(Replace(WorksheetFunction.Clean(ship), Chr(160), Chr(32)), Chr(32))
If UBound(FullShipName) > 0 Then
If Left(FullShipName, 2) = "US" Or Left(FullShipName, 2) = "PC" Then
FullShipName(0) = Chr(32)
End If
strFullShipName = Trim(Join(FullShipName, Chr(32)))
If InStr(strFullShipName, Chr(46)) > 0 Then
SplitShipName = Split(strFullShipName, Chr(32))
For Each NamePart In SplitShipName
If InStr(NamePart, Chr(46)) > 0 Then
NamePart = UCase(NamePart)
End If
Next
strFullShipName = Trim(Join(SplitShipName, Chr(32)))
' Debug.Print strFullShipName
If InStr(strFullShipName, Chr(40)) > 0 Then
CharPos = InStr(strFullShipName, Chr(40))
strFullShipName = Left(strFullShipName, CharPos - 1) & Chr(33) & Mid(strFullShipName, CharPos)
SplitShipName = Split(strFullShipName, Chr(33))
If UBound(SplitShipName) > 0 Then
SplitShipName(1) = UCase(SplitShipName(1))
End If
strFullShipName = Trim(Join(SplitShipName))
' Debug.Print strFullShipName
End If
STable(loopCounter - 13, 0) = strFullShipName
STable(loopCounter - 13, 1) = Range("F" & loopCounter)
ElseIf InStr(strFullShipName, Chr(40)) > 0 Then
CharPos = InStr(strFullShipName, Chr(40))
strFullShipName = Left(strFullShipName, CharPos - 1) & Chr(33) & Mid(strFullShipName, CharPos)
SplitShipName = Split(strFullShipName, Chr(33))
If UBound(SplitShipName) > 0 Then
SplitShipName(1) = UCase(SplitShipName(1))
End If
strFullShipName = Trim(Join(SplitShipName))
' Debug.Print strFullShipName
STable(loopCounter - 13, 0) = strFullShipName
STable(loopCounter - 13, 1) = Range("F" & loopCounter)
Else
strFullShipName = StrConv(strFullShipName, vbProperCase)
' Debug.Print strFullShipName
STable(loopCounter - 13, 0) = strFullShipName
STable(loopCounter - 13, 1) = Range("F" & loopCounter)
End If
End If
Debug.Print STable(loopCounter - 13, 0) & Chr(32) & STable(loopCounter - 13, 1)
loopCounter = loopCounter + 1
Next ship
End Select
End Sub
答案 0 :(得分：0)
Here is a link to a previous question regarding how to sort an array.
对数组进行排序后，只需创建一个循环，将所需值的特定数组位置粘贴回工作表。