losmac
"profesorek"
Typ:
neutral
Postów: 758
Zarejestrowany: May 2003
|
|
Skopiuj to do Excel'a i uruchom procedurę UtworzTablice()
Patrz na efekty 
Sub UtworzTablice()
Dim tablica() As String
Dim i As Long
Dim strTmp As String
Do While i < 26
ReDim Preserve tablica(i)
tablica(i) = Chr(i + 65)
i = i + 1
Loop
Do While i < 31
ReDim Preserve tablica(i)
tablica(i) = "Żaba " & i - 26
i = i + 1
Loop
Do While i < 36
ReDim Preserve tablica(i)
tablica(i) = "Kierunek " & i - 31
i = i + 1
Loop
ActiveSheet.Cells(1, 1) = "Tablica nie posortowana"
For i = LBound(tablica()) To UBound(tablica())
ActiveSheet.Cells(i + 2, 1) = tablica(i)
Next i
SortujTablice tablica
ActiveSheet.Cells(1, 4) = "Tablica posortowana rosnąco"
For i = LBound(tablica()) To UBound(tablica())
ActiveSheet.Cells(i + 2, 4) = tablica(i)
Next i
SortujTablice tablica, -1
ActiveSheet.Cells(1, 7) = "Tablica posortowana malejąco"
For i = LBound(tablica()) To UBound(tablica())
ActiveSheet.Cells(i + 2, 7) = tablica(i)
Next i
End Sub
'kierunek = 0 - sortowanie rosnące A-Z
'kierunek = -1 - sortowanie malejące Z-A
'k = -1 -> strTmp1 < strTmp2,
'k = 0 -> strTmp1 = strTmp2,
'k = 1 -> strTmp1 > strTmp2,
Sub SortujTablice(ByRef tablica() As String, Optional kierunek As Long = 0)
Dim i As Long, j As Long, k As Long
Dim strTmp As String
For i = LBound(tablica()) To UBound(tablica())
For j = i + 1 To UBound(tablica())
'A-Z
If StrComp(tablica(i), tablica(j), vbBinaryCompare) = 1 And kierunek = 0 Then
strTmp = tablica(i)
tablica(i) = tablica(j)
tablica(j) = strTmp
End If
'Z-A
If StrComp(tablica(i), tablica(j), vbBinaryCompare) = -1 And kierunek = -1 Then
strTmp = tablica(i)
tablica(i) = tablica(j)
tablica(j) = strTmp
End If
Next j
Next i
End Sub
_____________________________________________
POSTULATY STARUSZKA:
1) Ludzie, dbajcie o polszczyznę!!!
2) Ludzie, zadawajcie kompletne pytania, a nie rzucacie ochłapy i trzeba się domyślać o co chodzi!!!
Powodzenia
Maciej Łoś
|