vbamania.pl
login:
hasło:
 
  *Rejestracja *Zapomniane hasło
 Dziś jest piątek, 25 kwietnia 2025 roku.
Ustaw jako stronę startową Ulubione Napisz
PowrótPowrót do serwisu  RegulaminRegulamin rssRSS

  tytuł wątku:
Wątki dyskusji

Sortowanie tablicy danych


otwartyotwarty rozpoczął: janusz212 postów: 7



napisał: admin
postów: 613


umieszczony:
15 stycznia 2007
23:18

  
Witam.
Oto makro. Nie wiem tylko jak zrobić skrót klawiaturowy:D

Function CzytajTablice(lngMin As Long, lngMax As Long, lnCol As Long, ByRef vTablica() As Variant) As Long

Dim k As Long, w As Long
Dim k1 As Long, k2 As Long
Dim w1 As Long, w2 As Long
Dim k3 As Long, w3 As Long

k1 = Cells(2, lnCol).End(xlToLeft).Column
k2 = Cells(2, lnCol).End(xlToRight).Column
w1 = 2 'bo w pierwszym wierszu jest nagłówek kolumny
w2 = Cells(2, lnCol).End(xlDown).Row

k3 = k2 - k1 + 1
w3 = w1 - 1

For w = w1 To w2
   If Cells(w, lnCol).Value > lngMin And Cells(w, lnCol).Value < lngMax Then
      ReDim Preserve vTablica(1 To k3, 1 To w3)
      For k = k1 To k2
          k3 = k - k1 + 1
          vTablica(k3, w3) = Cells(w, k).Value
      Next k
      w3 = w3 + 1
    End If
Next w

CzytajTablice = lnCol - k1 + 1

End Function

Sub WpiszTablice(vTablica() As Variant, lnCol As Long)

Dim k As Long, w As Long
Dim k1 As Long, w1 As Long

k1 = Cells(2, lnCol).End(xlToLeft).Column
k2 = Cells(2, lnCol).End(xlToRight).Column
w2 = Cells(2, lnCol).End(xlDown).Row

Range(Cells(2, k1).Address, Cells(w2, k2).Address).ClearContents

For k = LBound(vTablica, 1) To UBound(vTablica, 1)
    w1 = 2
    For w = LBound(vTablica, 2) To UBound(vTablica, 2)
        Cells(w1, k1).Value = vTablica(k, w)
        w1 = w1 + 1
    Next w
    k1 = k1 + 1
Next k

End Sub


Sub SortujTablice(ByRef vTab, lnNumerKolumny As Long)
'Procedura sortująca (sortowanie bąbelkowe)

Dim bSorted As Boolean
Dim i As Long, vTemp() As Variant

Dim lngL As Long, lngU As Long

lngL = LBound(vTab, 2)
lngU = UBound(vTab, 2)
ReDim vTemp(lngL To lngU)

bSorted = False

Do Until bSorted
    bSorted = True
   
    For i = lngL + 1 To lngU
       lngV1 = vTab(lnNumerKolumny, i - 1)
       lngV2 = vTab(lnNumerKolumny, i)
       If lngV1 > lngV2 Then
          bSorted = False
          For k = LBound(vTab, 2) To UBound(vTab, 2)
             vTemp(k) = vTab(k, i - 1)
          Next k
          For k = LBound(vTab, 2) To UBound(vTab, 2)
             vTab(k, i - 1) = vTab(k, i)
          Next k
          For k = LBound(vTab, 2) To UBound(vTab, 2)
             vTab(k, i) = vTemp(k)
          Next k
       End If
    Next i
   
Loop

End Sub

Sub Start()

Dim lngCol As Long, lngCol2 As Long, lngDmin As Long, lngDmax As Long
Dim vTab() As Variant

lngDmin = CLng(InputBox("Podaj minimalną ilość dni", "Podaj"))
lngDmax = CLng(InputBox("Podaj maksymalną ilość dni", "Podaj"))
If lngDmin = 0 Or lngDmax = 0 Then Exit Sub

lngCol = ActiveSheet.Range("G:G").Column
lngCol2 = CzytajTablice(lngDmin, lngDmax, lngCol, vTab)
SortujTablice vTab, lngCol2
WpiszTablice vTab, lngCol

End Sub

napisał: janusz212
postów: 3


umieszczony:
14 stycznia 2007
21:11

  
Cieszę się bardzo że się odezwałes. Z góry dziękuję za pomoc. Odpowiadam na pytania:
1. Plik jest w excelu.
2. W kolumnach. Kolumna ilośc dni w "G"
3. Wynik działania makra ma zastąpić tablicę macierzystą.
4. Nie.
5. Makro ma być uruchamiane przez skrót klawiaturowy.
napisał: admin
postów: 613


umieszczony:
14 stycznia 2007
18:55

  
Podane przeze mnie procedury stanowią uniwersalny "silnik". Należy do tego dołożyć jeszcze interfejs użytkownika.
W takim razie potrzebuję więcej informacji:
1.W jakiej aplikacji macierzystej pracuje makro?
2. W jakiej postaci są dane - czyli tablica? W kolumnach i wierszach Excela?
3. Gdzie należy wpisać wynik działania makra?
4. Czy dane oryginalne należy zachować?
5. W jaki sposób użytkownik ma uruchamiać makro?
napisał: janusz212
postów: 3


umieszczony:
14 stycznia 2007
16:09

  
Serdecznie dziękuję za informacje przekazane dotychczasowo, ale bardzo zależy mi aby użytkownik w trakcie działania makra określał warunki, tzn określał zakres dni, które będą wpływać na tworzenie się tablicy. Niestety nie umiem określić tablic w stosunku do siebie i na dodatek z funkcją pozwalającą na wprowadzenie podczas pracy makra nadmienionych uprzednio warunków. Uprzejmie proszę za pomoc i za pracę włożoną w dotychczasową pomoc.
napisał: admin
postów: 613


umieszczony:
14 stycznia 2007
12:46

  
Sprawa na pierwszy rzut oka wygląda na banalną. Ale niestety całkiem banalna nie jest.
Moje rozwiązanie polega na tym, by rozbić to zadanie na dwie procedury:
1. Jedna tworzy tablicę wynikową, wypełnioną danymi spełniającymi warunki odnośnie liczby dni.
2. Druga to już prosta procedura sortująca.

Obydwie procedury wywoływane są z innej, zewnętrznej procedury.

1. Procedura pierwsza:
Sub OkreslTablice(lngMin As Long, lngMax As Long, lngNumerKolumny As Long, vTablica(), ByRef vTablicaWynikowa())

Dim k As Long, k1 As Long, k2 As Long, k3 As Long
Dim m1 As Long, m2 As Long

m1 = LBound(vTablica, 1)
m2 = UBound(vTablica, 1)
k1 = LBound(vTablica, 2)
k = k1

'Najpierw przepisujemy tablice źródłową do wynikowej
For j = LBound(vTablica, 2) To UBound(vTablica, 2)
  If vTablica(lngNumerKolumny, j) > lngMin And vTablica(lngNumerKolumny, j) < lngMax Then
    ReDim Preserve vTablicaWynikowa(m1 To m2, k1 To k)
    For i = m1 To m2
        vTablicaWynikowa(i, k) = vTablica(i, j)
    Next i
    k = k + 1
  End If
Next j

End Sub



2. Procedura sortująca:
Sub SortujTablice(ByRef vTab, lnNumerKolumny As Long)
'Procedura sortująca (sortowanie bąbelkowe)

Dim bSorted As Boolean
Dim i As Long, vTemp() As Variant

Dim lngL As Long, lngU As Long

lngL = LBound(vTab, 2)
lngU = UBound(vTab, 2)
ReDim vTemp(lngL To lngU)

bSorted = False

Do Until bSorted
   bSorted = True
   
   For i = lngL + 1 To lngU
      lngV1 = vTab(lnNumerKolumny, i - 1)
      lngV2 = vTab(lnNumerKolumny, i)
      If lngV1 > lngV2 Then
         bSorted = False
         For k = LBound(vTab, 1) To UBound(vTab, 1)
            vTemp(k) = vTab(k, i - 1)
         Next k
         For k = LBound(vTab, 1) To UBound(vTab, 1)
            vTab(k, i - 1) = vTab(k, i)
         Next k
         For k = LBound(vTab, 1) To UBound(vTab, 1)
            vTab(k, i) = vTemp(k)
         Next k
      End If
   Next i
   
Loop

End Sub



3. Przykładowe wywołanie procedur:
OkreslTablice 90, 200, 4, vTab, vTab2
SortujTablice vTab2, 4

napisał: janusz212
postów: 3


umieszczony:
13 stycznia 2007
20:05

  
W pięciu kolumnach wystepują dane. Dane nalezy dokonać posortowania tablicy wykorzystując pętlę. Kolumna czwarta z etykietą "Ilość dni" jest wyróznikiem który bierze udział w segregacji tablicy. W założeniu, uzytkownik makra ma podać zakres dni od - do, np. 90 do 200, makro powinno:
-wykorzystując kolumnę "Ilośc dni" usunąc te rekordy, które nie spełniają warunku podanego przez uzytkownika, np. kiedy w rekordzie w kolumnie "Ilość dni" wystąpi 89 - rekord winien być usunięty lub jeżeli w kolumnie "Ilość dni" wystąpi 201, rekord powinien być usunięty.

Pozdrawiam serdecznie wszystkich którzy mi pomogą.
Dziękuję uprzejmie.


<-wstecz  1  dalej->
wszystkich stron: 1


Sortuj posty: z