napisał: Ala
postów: 16
 umieszczony:
10 listopada 2010
21:21
|
|
Treborze !!
Jesteś geniuszem.
Program działa znakomicie. Dokładnie robi to, o co chodziło. Program jest szokująco szybki. Niby drobiazg a jakie ułatwienie. Reszta pracy to już będzie dla mnie przyjemne zajęcie, zrobię odpowiednie pętle bez kłopotu.
Wielkie dzięki!
Ala  |
|
|
napisał: Trebor
postów: 1209
umieszczony:
10 listopada 2010
17:16
|
|
Poprawiony kod dla prawie sztywnych zakresów dla pierwszej serii danych:
Sub unikaty()
Dim i As Long, j As Long, tbla, tbla1(), ostatnia As Long, liczba As Integer, kol As New Collection
Dim a As String
liczba = 10
If liczba = 0 Then Exit Sub
With ThisWorkbook.Sheets("Arkusz1")
ostatnia = .Columns(27).Find(What:="*", After:=.Cells(1, 27), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
tbla = .Range(.Cells(1, 27), .Cells(ostatnia, 27))
On Error Resume Next
For i = ostatnia To 1 Step -1
kol.Add tbla(i, 1), CStr(tbla(i, 1))
Next i
On Error GoTo 0
If kol.Count < liczba Then liczba = kol.Count
End With
'wyprowadzenie
With ThisWorkbook.Sheets("Arkusz2")
ostatnia = .Rows(31).Find(What:="*", After:=.Cells(31, 1), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Column
tbla = .Range(.Cells(31, 45), .Cells(31, ostatnia))
ReDim tbla1(1 To ostatnia - 44)
For j = 1 To ostatnia - 44
For i = 1 To liczba
a = kol(i)
If Replace(tbla(1, j), "kod", "") = kol(i) Then Exit For
Next i
If i > liczba Then tbla1(j) = 0 Else tbla1(j) = 1
Next j
.Range(.Cells(31 + 1, 45), .Cells(31 + 1, ostatnia)) = tbla1
End With
End Sub |
|
|
napisał: Ala
postów: 16
umieszczony:
10 listopada 2010
09:29
|
|
Uprzejmie dziękuję za skasowanie niespakowanego załącznika i jeszcze raz przepraszam za wadliwe załączenie .
Ala |
|
|
napisał: Ala
postów: 16
umieszczony:
10 listopada 2010
00:00
|
|
Przepraszam, spakowałam.
Ale jak teraz skasować ten większy o 3 Kilo niespakowany plik?
Pakowałam plik Excela pierwszy raz w życiu.
Ala |
|
|
napisał:  admin
postów: 613
umieszczony:
9 listopada 2010
22:53
|
|
| Cytat: A ponadto jeśli program zadziała z przykładowym uproszczonym skoroszytem to zawsze zadziała.
To prawda...
ale spakować załącznika, to nigdy nie zaszkodzi... |
|
|
napisał: Ala
postów: 16
umieszczony:
9 listopada 2010
22:36
 edytowany:
9 listopada 2010
23:56
|
|
Załączam przykładowy ogromnie uproszczony skoroszyt. 22,3 KB.
2 arkusze,
arkusz1 wejściowy:
1) kolumna AA od wiersza nr 1 do końca danych, ilość różnych danych w tej kolumnie wynosi 15, przykładowo chcę wyłowić 10 ostatnich unikatów;
2) Kolumna AC od wiersza nr 1 do końca danych, ilość różnych danych w tej kolumnie wynosi 50, przykładowo chcę wyłowić 17 ostatnich unikatów;
arkusz 2 wyjściowy:
1) tabela1 AA pozioma jest usadowiona od kolumny AS wiersze 30, 31,32 do kolumny BG wiersze 30, 31, 32;
2) tabela2 AC pozioma jest usadowiona od kolumny BI wiersze 43, 44, 45 do kolumny DF wiersze 43, 44, 45.
Dane wpisane do tabeli w sposób oczekiwany od programu.
W tabeli 1 AA zmieniły wartości z zera na jeden kody: 2, 7, 9, 10, 1, 13, 8, 14, 3, 11, czyli 10 ostatnich.
W tabeli 2 AC zmieniły się wartości z zera na 1 siedemnastu ostatnich unikatów, czyli kody: 50, 28, 47, 13, 12, 3, 10, 34, 6, 32, 33, 27, 26, 25, 24, 15, 43.
Reszta komórek pozostała wyzerowana.
Ala
P.S.
Nie ma żadnego sensu wysyłać rzeczywistego skoroszytu, bo przede wszystkim posiada zbyt duże rozmiary plików, łącznie miliony komórek z danymi. A ponadto jeśli program zadziała z przykładowym uproszczonym skoroszytem to zawsze zadziała. |
|
|
napisał: Trebor
postów: 1209
umieszczony:
9 listopada 2010
20:57
|
|
Daj to w skoroszycie który musisz spakować (pisał o tym admin).
Niech będą w pierwszym arkuszu dane wejściowe.
W drugim przykładowe dane wyjściowe (może być z efektem docelowym)
Amen |
|
|
napisał: Ala
postów: 16
umieszczony:
9 listopada 2010
20:49
edytowany:
9 listopada 2010
20:57
|
|
Program stworzony przez Kol. Trebora:
Sub unikaty()
Dim i As Long, j As Long, tbla, tbla1(), ostatnia As Long, adres As Range, liczba As Integer, kol As New Collection
Dim a As String
On Error Resume Next
Set adres = Application.InputBox("Kliknij na dowolną komórkę w kolumnie z której mają być wyszukane unikaty ", Type:=8)
If adres Is Nothing Then Exit Sub
liczba = Application.InputBox("Podaj ilość unikatów")
On Error GoTo 0
If liczba = 0 Then Exit Sub
With adres.Parent
ostatnia = .Columns(adres.Column).Find(What:="*", After:=.Cells(1, adres.Column), _
SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
tbla = .Range(.Cells(1, adres.Column), .Cells(ostatnia, adres.Column))
On Error Resume Next
For i = ostatnia To 1 Step -1
kol.Add tbla(i, 1), CStr(tbla(i, 1))
Next i
On Error GoTo 0
If kol.Count < liczba Then liczba = kol.Count
End With
'wyprowadzenie
Set adres = Nothing
On Error Resume Next
Set adres = Application.InputBox("Kliknij na dowolną komórkę w wierszu w której znajdują się kody.", Type:=8)
On Error GoTo 0
If adres Is Nothing Then Exit Sub
With adres.Parent
ostatnia = .Rows(adres.Row).Find(What:="*", After:=.Cells(adres.Row, 1), _
SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Column
tbla = .Range(.Cells(adres.Row, 1), .Cells(adres.Row, ostatnia))
ReDim tbla1(1 To ostatnia)
For j = 1 To ostatnia
For i = 1 To liczba
a = kol(i)
If tbla(1, j) = kol(i) Then tbla1(j) = 1
Next i
If tbla1(j) = "" Then tbla1(j) = 0
Next j
.Range(.Cells(adres.Row + 1, 1), .Cells(adres.Row + 1, ostatnia)) = tbla1
End With
End Sub
Program powinien wczytywać dane w określonej ilości unikatów branych od końca /od dołu kolumny/ z jakiejś kolumny jakiegoś arkusza jakiegoś skoroszytu /bez inputbox, lecz z samego kodu/ i następnie w tabeli umieszczonej w jakimś konkretnym skoroszycie w jakimś arkuszu i w jakimś wierszu zamieniać wyzerowane komórki tej tabeli na wartość w komórkach odpowiadających wartościom wyczytanym z wejściowej kolumny.
Czyli w kolosalnie uproszczonym przykładzie, np. w kolumnie wejściowej jest:
1
2
2
2
3
3
4
5
5
5
6
6
6
6
7
7
7
1
2
3
4
5
6
7
8
9
10
10
10
10
11
11
12
13
14
15
chcemy SPECYFICZNIE zaznaczyć w tabeli wyjściowej 7 ostatnich unikatów, są to: 15, 14, 13, 12, 11, 10, 9.
Pozioma Tabela wyjściowa znajdująca się w konkretnym jakimś skoroszycie, w konkretnym jakimś arkuszu i w konkretnym jakimś wierszu tego arkusza zaczynającym się w jakiejś odległej kolumnie i kończącym się na konkretnej kolumnie /czyli program powinien to sam czytać z kodu a nie z inputbox/ , ma 3 wiersze: od góry nagłówek główny, poniżej ponumerowane nagłówki komórek i wreszcie trzeci wiersz od góry to komórki, które są wstępnie wyzerowane.
W wyniku działania programu każda komórka znajdująca się pod nagłówkami: 15, 14, 13, 12, 11, 10, 9, powinna otrzymać wartość 1, zaś pozostałe komórki wartość zero.
Tymczasem program Kol. Trebora w ogóle nic nie robi prócz wyzerowania wszystkich roboczych komórek w tabeli wyjściowej.
Pracuję z tym programem już dość długo, trochę podszkoliłam się w VBA, chociaż oczywiście nadal są to początki. Niestety jeśli sama rozwiążę tę zagadkę, to chyba jedynie kosztem miesiecy a może lat.
Wygląda, że program nie robi tego, co powinien. Niestety program jest napisany poprawnie w tym sensie, że nie zgłasza żadnych błędów.
Program podoba mi się bardzo, ale czemu nie działa?
Kol. Trebor napisał, iż winę ponoszą moje wadliwe dane.
Ale przecież chodzi o to, że program winien pracować z każdymi danymi. Program nie zgłasza błędów, tylko nie robi tego, co ma robić.
Może Ktoś potrafi rozwiązać tę zagadkę?
Ala |
|
|
 wstecz 1 dalej  wszystkich stron: 1
|
|
Test programu unikaty.7z