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
|
|