napisał: markos97
postów: 114
 umieszczony:
16 lipca 2008
11:31
|
|
Sorka, zapomniałem o załączniku
[normalnie danych w skoroszycie mam około 10000 tyś. wierszy] w załączniku dla przykładu podaję około 100 |
|
|
napisał: markos97
postów: 114
umieszczony:
16 lipca 2008
11:29
|
|
Witam!
ostatecznie będę się chyba musiał zadowolić tym co przedstawiam w załączniku; zapomniałem jednak, że po pierwszej kolejce kopiowania danych do arkusza2, w komórkach na lewo od "B1" mam już jakieś tam dane; a ponieważ w kolejnej kolejce w miejsca te również wklejam dane musiałem dodać jeszcze do kodu opcję czyszczenia danych [clear]:
Sub B1()
Arkusz2.Columns(4).Clear
ActiveSheet.Autofilter.Range.Columns(2).Offset(1, 0).Copy Arkusz2.Range("D1")
End Sub
problem w tym, że całość dość długo działa, czego przyczyną jest jak podejrzewam powyższa opcja;
próbowałem jakoś to przyśpieszyć, ale nie daję rady, w związku z czym proszę Was o pomoc;
dla ułatwienia, do każdej z procedur dodałem sobie klawisze skrótu, i tak odpowiednio: [ctrl+Q do zaznaczania kolumn; ctrl+a do filtrowania danych; ctrl+z do wklejania danych do arkusza2]
do każdej z procedur pomocniczych [jedna z nich powyżej] próbowałem dodać coś w stylu:
Sub B1()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Arkusz2.Columns(4).Clear
ActiveSheet.Autofilter.Range.Columns(2).Offset(1, 0).Copy Arkusz2.Range("D1")
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
jednak bez większych rezultatów; nadal transfer danych z jednego arkusza do drugiego, jak i czyszczenie danych w arkuszu2 trwa zbyt długo;
z pozdrowieniami |
|
|
napisał: markos97
postów: 114
umieszczony:
24 czerwca 2008
17:43
|
|
Witam!
Dzięki za odopwiedź, ale problem wydaje się być jednak nieco bardziej złożony;
w związku z tym mam kilka pytań i ewentulanie własnych propozycji rozwiązania tego zadania;
nie jestem pewien czy powinienem zadawać je wszyskie naraz, ale postaram się nie skomplikować sprawy;
w tym celu przygotowałem sobie kilka kodów, aby jakoś naświetlić to zagadnienie;
Pytanie 1:
Czy istnieje taka możliwość, aby po uruchomieniu poniższych kodów, pierwszy kod, licząc od góry samoczynnie został usunięty z procedury zbiorczej:
Sub A1()
ActiveSheet.AutoFilter.Range.Columns(2).Offset(1, 0).Copy Arkusz2.Range("B1")
End Sub
Sub B1()
ActiveSheet.AutoFilter.Range.Columns(2).Offset(1, 0).Copy Arkusz2.Range("D1")
End Sub
Sub C1()
ActiveSheet.AutoFilter.Range.Columns(2).Offset(1, 0).Copy Arkusz2.Range("F1")
ActiveSheet.AutoFilterMode = False
End Sub
a także procedura zbiorcza:
Sub Autofilterki ()
Call A1
Call B1
Call C1
End Sub
[druga linijka trzeciego kodu sprawia, że bezpośrednio po uruchomieniu ustaje działanie programu, gdzie autofilter w arkuszu1 zostaje wyłączony; dane zaś trafiają odpowiednio do każdej z komórek docelowych, to jest w kolejności: ("B1"), ("D1"), oraz ("F1") do arukusza2;
i w tym miejscu chciałbym, aby pierwszy kod został automatycznie usunięty, dzięki czemu mógł bym spokojnie przejść do dwóch pozostałych kodów, nie martwiąc się o utratę danych w komórce ("B1"), kolejna zaś porcja nowych danych trafiła by tym razem już tylko do ("D1"), oraz ("F1"), a w ostatniej kolejce dane trafią już tylko do ("F1")
jeszcze zanim nie miałem pojęcia o czymś takim jak procedura zbiorcza radziłem sobie czymś takim:
Sub copyAuto1()
ActiveSheet.AutoFilter.Range.Columns(2).Offset(1, 0).Copy _
Arkusz2.Range("B1") '("D1")'("F1")'("H1")'("J1")'("L1")'("N1")
'("P1")'("R1")'("T1")'("V1")'("X1")'("Z1")
'("AB1")'("AD1")'("AF1")'("AH1")'("AJ1")'("AL1")'("AN1")'("AP1")
'("AR1")'("AT1")'("AV1")'("AX1")'("AZ1")'("BB1")'("BD1")'("BF1")
'("BH1")'("BJ1")'("BL1")'("BN1")'("BP1")'("BR1")'("BT1")'("BV1")
'("BX1")'("BZ1")'("CB1")'("CD1")'("CF1")'("CH1")'("CJ1")'("CL1")
'("CN1")'("CP1")'("CR1")'("CT1")'("CV1")'("CX1")'("CZ1")'("DB1")
'("DD1")'("DF1")'("DH1")'("DJ1")'("DL1")'("DN1")'("DP1")'("DR1")
'("DT1")'("DV1")'("DX1")'("DZ1")'("EB1")'("ED1")'("EF1")'("EH1")
'("EJ1")'("EL1")'("EN1")'("EP1")'("ER1")'("ET1")'("EV1")'("EX1")
'("EZ1")'("FB1")'("FD1")'("FF1")'("FH1")'("FJ1")'("FL1")'("FN1")
'("FP1")'("FR1")'("FT1")'("FV1")'("FX1")'("FZ1")'("GB1")'("GD1")
'("GF1")'("GH1")'("GJ1")'("GL1")'("GN1")'("GP1")'("GR1")'("GT1")
'("GV1")'("GX1")'("GZ1")'("HB1")'("HD1")'("HF1")'("HH1")'("HJ1")
'("HL1")'("HN1")'("HP1")'("HR1")'("HT1")'("HV1")'("HX1")'("HZ1")
'("IB1")'("ID1")'("IF1")'("IH1")'("IJ1")'("IL1")'("IN1")'("IP1")
'("IR1")'("IT1")'("IV1")
ActiveSheet.AutoFilterMode = False
End Sub
zasada działania i efekt końcowy analogicznie do tego co powyżej są takie same;
adresy komórek docelowych oddzieliłem sobie znacznikiem komentarza [bo jak pamiętacie dla kilku zakresów jednym makrem nie dało się tego wykonać], i za każdym kolejnym uruchomieniem procedury usuwałem ręcznie pierwszą komórkę docelową, aby nie naruszuś już później danych w tej komórce, no a tym samym dane te mam już na stałe stablicowane [o co usilnie zabiegam];
Pytanie 2:
Sytuacja może też wyglądać tak:
Sub A1()
ActiveSheet.AutoFilter.Range.Columns(2).Offset(1, 0).Copy Arkusz2.Range("B1")
ActiveSheet.AutoFilterMode = False
End Sub
Sub B1()
ActiveSheet.AutoFilter.Range.Columns(2).Offset(1, 0).Copy Arkusz2.Range("D1")
ActiveSheet.AutoFilterMode = False
End Sub
Sub C1()
ActiveSheet.AutoFilter.Range.Columns(2).Offset(1, 0).Copy Arkusz2.Range("F1")
ActiveSheet.AutoFilterMode = False
End Sub
[procedura zbiorcza nie jest w tym wypadku już nam potrzebna]
no, ale tym razem, należy sobie postawić pytanie, czy da się zastosować coś w rodzaju "Choose Function", gdzie najpierw uruchomione zostanie makro1, a dane trafią do ("B1"), a następnie przy uruchomieniu makra2, dane trafiają do ("D1"), itd. [oczywiście za każdym razem w arkusz1 dokonujemy wyboru nowych danych do kopiowania]
dzięki za ewentulne porady
z pozdrowieniami |
|
|
napisał: markos97
postów: 114
umieszczony:
17 czerwca 2008
11:53
|
|
Witam!
chyba jednak nie da się tego wykonać dla kilku zakresów; jak widać ...
Cytat:
...Komunikaty błędów w niedopracowanych funkcjach górują nad arkuszami Excela, na szczęście dość rzadko, i we wszystkich napotkanych przeze mnie przypadkach w jakiś sposób da się ten problem obejść
,co można przeczytać chociażby na poniższej stronce:
http://elsinterakcja.pl/2006/07/excel-znaczy-gorowac/
Zastanawiałem się jak to obejść i doszedłem do wniosku, że możliwe jest to do zrobnienia co najwyżej na jednej komórce adresowej;
ja zamierzam jednak filtrować dane i wklejać je do nowego arkusza co najmniej kilkadziesiąt razy; wymusiło to więc, aby zastosować dla każdej nowej porcji danych osobne, choć w zasadzie takie samo makro:
Sub autofilter1()
ActiveSheet.AutoFilter.Range.Columns(1).Offset(1, 0).Copy Arkusz2.Range("B1")
ActiveSheet.AutoFilterMode = False
End Sub
Sub autofilter2()
ActiveSheet.AutoFilter.Range.Columns(1).Offset(1, 0).Copy Arkusz2.Range("D1")
ActiveSheet.AutoFilterMode = False
End Sub
Sub autofilter3()
ActiveSheet.AutoFilter.Range.Columns(1).Offset(1, 0).Copy Arkusz2.Range("F1")
ActiveSheet.AutoFilterMode = False
End Sub
Sub autofilter4()
ActiveSheet.AutoFilter.Range.Columns(1).Offset(1, 0).Copy Arkusz2.Range("H1")
ActiveSheet.AutoFilterMode = False
End Sub
itd...
w momencie uruchamiania makropolecenia kursor w module kodu ustawiam na samej górze, przez co w sekcji kodu po lewej stronie mam (Genral), no a po prawej pojawia mi się (Declarations);
za każdym razem kiedy chcę uruchomić makro muszę zdeklarować, które z nich chciałbym uruchomić;
i teraz pytanie: czy istnieje możliwość, aby Basic automatycznie uruchamiał je każde po kolei, bo na razie to ja muszę ręcznie wybierać czy ma to być Sub autofiler1 (), Sub autofiler2 (), Sub autofiler3 (), czy też może Sub autofiler4 () i za każdym razem jestem zmuszony dokonywać wyboru
z pozdrowieniami |
|
|
napisał: markos97
postów: 114
umieszczony:
9 czerwca 2008
13:32
|
|
Witam!
Dzięki za odpowiedź;
wynalazek całkiem niezły; jednak mnie chodziło o coś troszkę innego; mówiąc 4 pole [field:=4] miałem na myśli, aby wszystkie komórki z tej kolumny znalazły się np. w "B1", a następnie poprzez B2,B3,B4,B5 itd. w zależności ile komórek autofilter wygenerował; i analogicznie do tego w "D1" poprzez D2,D3,D4,D5; natomiast twój kodzik dokonuje transpozycji danych, tj. z orientacji pionowej, jaka miała miejsce w Arkuszu1, zmienia ją na orientację poziomą; ale nie ważne; na poniższej stronie udało mi się wyłuskać poniższy kodzik:
http://www.ozgrid.com/forum/showthread.php?t=93248
a oto ten kod:
Sub macro1()
ActiveSheet.AutoFilter.Range.Copy Arkusz2.Range("B1")
End Sub
bądź też podobny:
http://www.ozgrid.com/forum/showthread.php?t=92721
Sub macro2()
ActiveSheet.AutoFilter.Range.Offset(1, 0).Copy Arkusz2.Range("B1")
End Sub
ok., następnie na tej podstawie opierając się jednak na Twoim kodzie i zauważając w nich podobieństwo zmodyfikowałem go sobie dodając od Ciebie z poniższej linijki:
Set RangFltColumn = ActiveSheet.AutoFilter.Range.Columns(4).SpecialCells(xlCellTypeVisible)
co wygląda ostatecznie tak:
Sub copyFltrData()
ActiveSheet.AutoFilter.Range.Columns(4).Copy Arkusz2.Range("B1," & _
"D1,F1,H1,J1,L1,N1,P1,R1,T1,V1,X1,Z1," & _
"AB1,AD1,AF1,AH1,AJ1,AL1,AN1,AP1,AR1,AT1,AV1,AX1,AZ1," & _
"BB1,BD1,BF1,BH1,BJ1,BL1,BN1,BP1,BR1,BT1,BV1,BX1,BZ1," & _
"CB1,CD1,CF1,CH1,CJ1,CL1,CN1,CP1,CR1,CT1,CV1,CX1,CZ1," & _
"DB1,DD1,DF1,DH1,DJ1,DL1,DN1,DP1,DR1,DT1,DV1,DX1,DZ1," & _
"EB1,ED1")
End Sub
w powyższej postaci działa bez zarzutów; ale:
1) w momencie gdy powyższy zakres zwiększę chociażby o jedną komórkę docelową pojawia się następujący komunikat:
Run-time error '1004'
Application-defined or object-defined error
2) pomimo, że w zakresie komórek parametry ustawiam na wiersz1 np. na Range("B1,D1,F1,H1,J1,L1,N1,P1...") to i tak komórki wędrują do wiersza2
co do drugiego problemu wydaje się, że drugi kod, mógłby być rozwiązaniem, po odpowiednim jednakże jego zmodyfikowaniu, to jest po dodaniu Offset(1,0):
Sub macro2()
ActiveSheet.AutoFilter.Range.Columns(4).Offset(1, 0).Copy Arkusz2.Range("B1")
End Sub
jednak w tym przypadku z kolei nie jestem w stanie dodać już, nawet jednej komórki docelowej, a więc jeżeli np. zwiększę szereg o chociażby jedną komórkę:
Sub macro2()
ActiveSheet.AutoFilter.Range.Columns(4).Offset(1, 0).Copy Arkusz2.Range("B1,D1")
End Sub
to automatycznie wywala mi poniższy komunikat:
Wykonanie tego polecenia dla kilku zakresów nie jest możliwe.
Czy jest ktoś jeszcze w stanie jakoś pomóc?
z pozdrowieniami |
|
|
napisał: LAnd
postów: 107
umieszczony:
8 czerwca 2008
08:25
|
|
wypróbuj poniższy wynalazek jak co to dostosuj do swoich potrzeb
Sub copyFltrData()
Dim RangFltColumn As Range, i, Ark2AdresArr
Dim InpCel As Range
'tablica adresów docelowych
Ark2AdresArr = Split("B1,D1,F1,H1,J1,L1,N1,P1,R1,T1,V1,X1,Z1," & _
"AB1,AD1,AF1,AH1,AJ1,AL1,AN1,AP1,AR1,AT1,AV1,AX1,AZ1," & _
"BB1,BD1,BF1,BH1,BJ1,BL1,BN1,BP1,BR1,BT1,BV1,BX1,BZ1," & _
"CB1,CD1,CF1,CH1,CJ1,CL1,CN1,CP1,CR1,CT1,CV1,CX1,CZ1," & _
"DB1,DD1,DF1,DH1,DJ1,DL1,DN1,DP1,DR1,DT1,DV1,DX1,DZ1," & _
"EB1,ED1,EF1,EH1,EJ1,EL1,EN1,EP1,ER1,ET1,EV1,EX1,EZ1," & _
"FB1,FD1,FF1,FH1,FJ1,FL1,FN1,FP1,FR1,FT1,FV1,FX1,FZ1," & _
"GB1,GD1,GF1,GH1,GJ1,GL1,GN1,GP1,GR1,GT1,GV1,GX1,GZ1," & _
"HB1,HD1,HF1,HH1,HJ1,HL1,HN1,HP1,HR1,HT1,HV1,HX1,HZ1," & _
"IB1,ID1,IF1,IH1,IJ1,IL1,IN1,IP1,IR1,IT1,IV1", ",")
'widoczne komórki kolumny 4 filtrowanego obszaru
Set RangFltColumn = ActiveSheet.AutoFilter.Range.Columns(4).SpecialCells(xlCellTypeVisible)
i = 0
For Each InpCel In RangFltColumn.Cells
i = i + 1
If i < 2 Then
'pominięcie wiersza nagłowka
ElseIf i - 2 > UBound(Ark2AdresArr) Then
'i przekracza ilość elementów tablicy adresów
Exit For
Else
InpCel.Copy Worksheets("Arkusz2").Range(Ark2AdresArr(i - 2))
End If
Next
End Sub |
|
|
napisał: markos97
postów: 114
umieszczony:
7 czerwca 2008
12:00
|
|
Witam!
mam prosty kod filtrujący dane, np.:
[dane znajdują się w "Arkusz1"]
Sub Makro5()
Selection.AutoFilter
Selection.AutoFilter Field:=1, Criteria1:="5"
Selection.AutoFilter Field:=2, Criteria1:="6"
Selection.AutoFilter Field:=3, Criteria1:="7"
Selection.AutoFilter Field:=4, Criteria1:="99"
End Sub
i teraz najtrudniejsze; otóż chciałbym z tych przefiltrowanych danych,
skopiować do "Arkusz2", czwarte pole [Field:=4], ale zaznaczam tylko 4 pole!
gdyby chodziło o wszystkie pola rozwiązanie już posiadam;
byłoby dobrze, gdyby, dane po wklejeniu do "Arkusz2" znalazły się w:
Range("B1,D1,F1,H1,J1,L1,N1,P1,R1,T1,V1,X1,Z1," & _
"AB1,AD1,AF1,AH1,AJ1,AL1,AN1,AP1,AR1,AT1,AV1,AX1,AZ1," & _
"BB1,BD1,BF1,BH1,BJ1,BL1,BN1,BP1,BR1,BT1,BV1,BX1,BZ1," & _
"CB1,CD1,CF1,CH1,CJ1,CL1,CN1,CP1,CR1,CT1,CV1,CX1,CZ1," & _
"DB1,DD1,DF1,DH1,DJ1,DL1,DN1,DP1,DR1,DT1,DV1,DX1,DZ1," & _
"EB1,ED1,EF1,EH1,EJ1,EL1,EN1,EP1,ER1,ET1,EV1,EX1,EZ1," & _
"FB1,FD1,FF1,FH1,FJ1,FL1,FN1,FP1,FR1,FT1,FV1,FX1,FZ1," & _
"GB1,GD1,GF1,GH1,GJ1,GL1,GN1,GP1,GR1,GT1,GV1,GX1,GZ1," & _
"HB1,HD1,HF1,HH1,HJ1,HL1,HN1,HP1,HR1,HT1,HV1,HX1,HZ1," & _
"IB1,ID1,IF1,IH1,IJ1,IL1,IN1,IP1,IR1,IT1,IV1")
z pozdrowieniami |
|
|
 wstecz 1 dalej  wszystkich stron: 1
|
|
Zeszyt1.xls