Excel Forum - Porady, Pomoc, Excel Help, Excel FAQ - ankieta i wyniki

kati · Starszy Forumowicz Posty: 54

Witam
Potrzebuje taki manewr wpisac w makro: wyniki ankiet - one teraz sa widoczne w ark3/kol. M, ale kolumna bedzie ukryta dla uzytkownikow - zeby automatycznie kopiowaly sie do arkusza1 "wyniki_ankiet". Ktory btw tez ma byc docelowo ukryty. Automatycznie w tym sensie, ze nie w czasie rzeczywistym, tylko pod batonik przy zatwierdzaniu ankiety chce podpiac operacje przerzucenia kopii tych wynikow.
Z tym, ze z transpozycja: wiersze 2-12 to jest metryczka kazdej indywidualnej ankiety, ktora ma sie wpisywac do kol. C - I w arkuszu wynikowym. No i dla kazdej ankiety - w jednym, wlasciwym wierszu - wyniki, jak ten przyklad w ark1/wiersz5.

Byloby zbyt proste, gdybym dala zlinkowane komorki pomiedzy jednym = drugim arkuszem. Ale kolejne arkusze z kazda kolejna ankieta tworzone sa z wyjsciowej wersji ankiety przez makro [zobaczcie Alt+F11]. A nigdy z gory nie jest wiadome, ile za dany okres sprawozdawczy bedzie umow, podlegajacych ankietom w badanych obszarach. I ile bedzie arkuszow. Jak to rozpracowac?

Please help. Nie mam pojecia, jak z tego wybrnac..

[ Dodano: 2012-02-02, 07:14 ]
Uuh :-|

Jesli byl juz taki watek na forum wrzuccie chociaz linka, moze przeoczylam?
Poradzcie cos prosze, bez tego lezy mi kwartalne sprawozdanie

ankieta.zip

Pobierz Plik ściągnięto 13 raz(y) 16.78 KB

Kaper · Excel Expert **Pomógł:** 1152 razy Posty: 1626

generalnie:
potrzebujesz informacji o pierwszym wolnym wierszu w arkuszu podsumowującym
wpisz na forum w szukajce np. funkcja last() albo wykorzystaj konstrukcję zbliżoną do tej

Kod:

wolny_wiersz=range("komórka nagłówkowa").end(xldown).row+1

i po zakończeniu ankiety np. po kliknięciu zrób przeniesienie danych z odpowiednich komórek do tak wyznaczonego wiersza.
np.

Kod:

worksheets("wyniki_ankiet").Range("J"&wolny_wiersz)=Activesheet.Range("M14").value

i podobnie z innymi polami. Takie podejście uniezależni Cię od liczby kolejnych ankiet generowanych po każdorazowym naciśnięciu PrzejdźDalej

Pozdrawiam,

kati · Starszy Forumowicz Posty: 54

Kaper · Excel Expert **Pomógł:** 1152 razy Posty: 1626

Może takich kilka podpowiedzi do jednej z procedur obsługi przycisku 3 będzie pomocne.

Kod:

Sub Przycisk3_Kliknięcie()
Dim wolny As Long

' proponuję najpierw skopiować
Sheets("ankieta").Select
Sheets("ankieta").Copy After:=Worksheets(Worksheets.Count)
'i zmienić nazwę (może na inną - zawierającą np. numer umowy albo po prostu kolejny nr ankiety
ActiveSheet.Name = "ankieta" & Worksheets.Count - 3
' aż do "End With" samo .cośtam będzie traktowane jak Worksheets("wyniki_ankiet").cośtam
With Worksheets("wyniki_ankiet")
'obliczamy gdzie w zbiorczy można wpisywać
wolny = .Range("F2").End(xlDown).Row + 1
' i przepisujemy nagłówek
.Range("C" & wolny) = Range("D2")
.Range("D" & wolny) = Range("D4") & "-" & Range("E4") & "-" & Range("F4") & "-" & Range("G4")
.Range("E" & wolny) = Range("D6")
.Range("F" & wolny) = Range("H8")
' itd.
' oraz zapisujemy nr kolejny
.Range("B" & wolny) = .Range("B" & wolny - 1) + 1
'teraz wyniki korzystając z Twojej konstrukcji pozostałej po rejetratorze makr
Range("M14").Select
.Range("J" & wolny) = Selection.Value
Selection.End(xlDown).Select
.Range("K" & wolny) = Selection.Value
Selection.End(xlDown).Select
.Range("L" & wolny) = Selection.Value
Selection.End(xlDown).Select
.Range("M" & wolny) = Selection.Value
Range("d2").Select
End With
' a tu Twoje zerowanie arkusza ankieta (też po rejestratorze)
Sheets("ankieta").Select
Range("M14").Select
Selection.FormulaR1C1 = "0"
Selection.End(xlDown).Select
Selection.FormulaR1C1 = "0"
Selection.End(xlDown).Select
Selection.FormulaR1C1 = "0"
Selection.End(xlDown).Select
Selection.FormulaR1C1 = "0"
' no i jeszcze przydałoby się zerowanie "metryczki" czyli D2, D4:H4 itd.
Range("d2").Select
End Sub

Zostawiłem te wszystkie Selection.End(xlDown).Select ale zamiast nich mogłoby się obejść bez selekcji czyli przy przepisywaniu:

Kod:

.Range("J" & wolny)=Range("M14").value
.Range("K" & wolny)=Range("M24").value
' itd

a przy zerowaniu

Kod:

Range("M14").value=0
Range("M24").value=0
' itd

Pozdrawiam,

kati · Starszy Forumowicz Posty: 54

Kaper · Excel Expert **Pomógł:** 1152 razy Posty: 1626

Ustawianie obszaru wydruku i uruchomienie drukowania możesz zrobić mniej więcej tak:

Kod:

Sub Drukuj()
With Worksheets("wyniki_ankiet")
.PageSetup.PrintArea = "$B$1:$O$" & .Range("F2").End(xlDown).Row
.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
End With
End Sub

Możesz też np. z końcem obszaru drukowania "pójść w górę" od ostatniego wiersza w arkuszu

Kod:

.PageSetup.PrintArea = "$B$1:$O$" & .cells(.cells.rows.count,"B").End(xlup).Row

A zerowanie w sensie: ustawianie "wybierz"
- pewnie najprościej mniej więcej tak:

Kod:

range("D4").value = "~ wybierz ~"

Pozdrawiam,

kati · Starszy Forumowicz Posty: 54

Kaper · Excel Expert **Pomógł:** 1152 razy Posty: 1626

no aż tak, to nie, bo skoro poziom jest wysoki to makro się nie uruchomi, prawda :-)

ale możesz "dać wyraźnie do zrozumienia", że włączona obsługa makr jest niezbędna.
Zobacz np.:
http://www.excelforum.pl/...highlight=wymus*+makr*
http://www.excelforum.pl/...highlight=wymus*+makr*
http://www.excelforum.pl/...highlight=wymus*+makr*
http://www.excelforum.pl/...kro-vt20913.htm

Inny pomysł - skoro "zbierasz ankiety" to może pliki z ankietami powinny być wolne od matk, a tylko potem wyniki poszczególnych ankiet przysłane przez tą setkę pracowników w 100 oddzielnych skoroszytach powinny być automatycznie zebrane przez makro i upchnięte do skoroszytu zbiorczego (i podsumowane w arkuszu zbiorczym).

Pozdrawiam,

kati · Starszy Forumowicz Posty: 54

Kaper · Excel Expert **Pomógł:** 1152 razy Posty: 1626

Czyli w ThisWorkbook (albo w tenskoroszyt :evil:

) coś w podobie do:

Kod:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim wks As Worksheet
Application.ScreenUpdating = False
' tylko arkusz z komunikatem o konieczności zezwolenia na makra będzie widoczny po otwarciu
Worksheets("Start").Visible = xlVisible
For Each wks In Worksheets
If wks.Name <> "Start" Then wks.Visible = xlVeryHidden
Next wks
End Sub

Private Sub Workbook_Open()
Call pokaz_arkusze
End Sub

A w zwykłym module coś w tym stylu:

Kod:

Sub pokaz_arkusze()
Dim wks As Worksheet
Application.ScreenUpdating = False
For Each wks In Worksheets
wks.Visible = xlSheetVisible
Next wks
' ew. wybór aktywnego i ukrycie startowego
Application.ScreenUpdating = True
End Sub

Albo ta ostatnia procedura wewnątrz workbook_open

Pozdrawiam,