napisał: rudolf78
postów: 5
 umieszczony:
8 kwietnia 2010
22:02
 edytowany:
8 kwietnia 2010
22:17
|
|
Witam,
a jakby zrobić to samo tylko, że dane są w arkuszach o zmiennej nazwie składajacej się ze słowa dane, podkreślnika i numeru
np
dane_123545
dane_156755
dane_476755
Jeżeli to coś ułatwi to otwierany plik ma taką samą nazwę jak arkusz w tym pliku (w pliku jest tylko jeden arkusz)
Kombinowałem mocno z tym makrem ale nie moge sobie dać rady?
Pomocy |
|
|
napisał: damianel
postów: 35
umieszczony:
20 sierpnia 2008
08:50
|
|
Jestem pod wrazeniem!!!! Dzieki wielkie  |
|
|
napisał: Rycho
postów: 291
umieszczony:
19 sierpnia 2008
22:23
|
|
Ok,
myślałem, że chodzi o kopiowanie jakich uporządkowanych danych (np. tabel).
Kolejna wersja makra kopiuje z arkuszy wszystko jak leci.
Jeśli w arkuszu wynikowym widać puste komórki czy wręcz puste całe wiersze, to znaczy że komórki te zostały sformatowane i jako takie puste nie są.
Sub test()
Dim path As String
Dim p As Long
path = ThisWorkbook.path & Application.PathSeparator & "dane"
p = ReadDataFromSheets(path, "mis", True)
MsgBox "Wczytano: " & p & " arkusze(y)", vbInformation, " T e s t"
End Sub
Function ReadDataFromSheets(path As String, _
SheetName As String, _
Optional SearchSubFolders As Boolean = True _
) As Long
'Copyleft: 2008 MR
'Opis: funkcja wczytuje dane do aktywnego arkusza
' ze skoroszytów zlokalizowanych w folderze 'Path'
' z arkuszy o nazwie 'SheetName'
' przeszukując podfoldery (domyslnie)
'Wynik: liczba wczytanych arkuszy
Const Odstep = 1 'odstęp pomiedzy danymi z kolejnych arkuszy
Dim FS As FileSearch
Dim i As Long, wynik As Long
Dim kom As Range, rg As Range
Dim shAct As Worksheet, sh As Worksheet, wb As Workbook
'pobranie listy plików
Set FS = Application.FileSearch
With FS
.NewSearch
.LookIn = path
.FileType = msoFileTypeExcelWorkbooks
.SearchSubFolders = SearchSubFolders
.Execute msoSortByFileName
End With
'nie 'migamy' ekranem
Application.ScreenUpdating = False
'wyłączamy obsługę zdarzeń (w otwieranych skoroszytach
'może być kod uruchamiany automatycznie)
Application.EnableEvents = False
'arkusz zestawienia czyli ten aktywny w momencie uruchomienia makra
Set shAct = ActiveSheet
'dla listy plików
For i = 1 To FS.FoundFiles.Count
'otwarcie skoroszytu
Set wb = Workbooks.Open(FS.FoundFiles(i))
'czy jest właściwy arkusz?
Set sh = Nothing
On Error Resume Next
Set sh = wb.Worksheets(SheetName)
On Error GoTo 0
If Not sh Is Nothing Then 'jeśli jest arkusz
'miejsce wstawienia danych
With shAct
If .UsedRange.Address(0, 0) = "A1" Then
Set kom = .Range("A1")
Else
Set kom = .Cells(.UsedRange.Row + _
.UsedRange.Rows.Count + Odstep, "A")
End If
End With
'zakres kopiowany
With sh
Set rg = .Range("A1", .UsedRange(.UsedRange.Count))
End With
'kopiowanie
rg.Copy kom
wynik = wynik + 1
End If
'zamknięcie skoroszytu
wb.Close False
Next i
Application.ScreenUpdating = True
Application.EnableEvents = True
ReadDataFromSheets = wynik
End Function |
|
|
napisał: damianel
postów: 35
umieszczony:
19 sierpnia 2008
15:43
|
|
np nie wyswietla wszystkich danych z pobieranych arkuszy (zalacznik) |
|
|
napisał: damianel
postów: 35
umieszczony:
19 sierpnia 2008
12:11
|
|
| Zgadza sie, ale testuj makro i nie dziala, nie wyswietla wszystkich danych, cos jest nie tak |
|
|
napisał: Rycho
postów: 291
umieszczony:
18 sierpnia 2008
18:36
|
|
Hej,
krótko mówiąc, chcesz mieć pusty wiersz pomiędzy danymi z poszczególnych arkuszy?
w części kodu:
'miejsce wstawienia danych = pierwszy wolny wiersz wg kolumny A
Set kom = shAct.Cells(Rows.Count, "A").End(xlUp)
If kom.Value <> "" Then Set kom = kom.Offset(1, 0)
zmień parametr metody offset, np. na:
[...] = kom.Offset(2, 0)
... a może trzeba gdzieś wstawić - jako nagłówek tabeli z poszczególnych arkuszy lub dla każdego wiersza w dodatkowej kolumnie - nazwę pliku, z którego dane pochodzą? |
|
|
napisał: damianel
postów: 35
umieszczony:
18 sierpnia 2008
15:17
|
|
Mamy powiedzmy 100 skoroszytow w kazdym jest arkusz o nazwie mis i makro ma pobierac dane z pierwszego arkusza i kopioac do arkusza jakiegos skoroszytu X nastepnie bierze kolejny arkusz o nazwie mis z kolejnego skoroszytu w naszej bazie i kopiujemy go pod danymi w arkuszu skoroszytu X ( po 100 razach bedziemy mieli 100 arkuszy jeden pod drugim w jednym arkuszu skoroszytu X)
Na tym polega problem, sprawdzalem Twoje makro, ale nie wychodzi kopiuje dane jedne pod drugimi, ale dane sa ze sobą pomieszane a my mamy miec tzw 100 "prostokątow"(arkuszy) jedne pod drugim, ale jakos nad tym pracuje zeby sobie pordzic, dzieki za pomoc, jak wpadnie Ci jakis pomysl to pisz |
|
|
napisał: Rycho
postów: 291
umieszczony:
15 sierpnia 2008
18:55
edytowany:
15 sierpnia 2008
18:58
|
|
Witam,
precyzja Twoich opisów potrzeb damianel jest ... ma wiele do życzenia.
Swój kod też tak piszesz?
Zobacz przykładowe rozwiązanie:
Sub test()
Dim path As String
Dim p As Long
path = ThisWorkbook.path & Application.PathSeparator & "dane"
p = ReadDataFromSheets(path, "mis", True)
MsgBox "Wczytano dane z " & p & " plików.", vbInformation, " T e s t"
End Sub
Function ReadDataFromSheets(path As String, _
SheetName As String, _
Optional SearchSubFolders As Boolean = True, _
Optional IsDataHeader As Boolean = True _
) As Long
'Copyleft: 2008 MR
'Opis: funkcja wczytuje dane do aktywnego arkusza
' ze skoroszytów zlokalizowanych w folderze 'Path'
' z arkuszy o nazwie 'SheetName'
' przeszukując podfoldery (domyslnie)
' pomijając nagłówek dla kolejnych danych (domyślnie)
'Wynik: liczba wczytanych arkuszy
Dim FS As FileSearch
Dim i As Long, w As Long, wynik As Long
Dim rg As Range, kom As Range
Dim shAct As Worksheet, sh As Worksheet, wb As Workbook
'pobranie listy plików
Set FS = Application.FileSearch
With FS
.NewSearch
.LookIn = path
.FileType = msoFileTypeExcelWorkbooks
.SearchSubFolders = SearchSubFolders
.Execute msoSortByFileName
End With
'nie 'migamy' ekranem
Application.ScreenUpdating = False
'wyłączamy obsługę zdarzeń (w otwieranych skoroszytach
'może być kod uruchamiany automatycznie)
Application.EnableEvents = False
'arkusz zestawienia czyli ten aktywny w momencie uruchomienia makra
Set shAct = ActiveSheet
'dla listy plików
For i = 1 To FS.FoundFiles.Count
'otwarcie skoroszytu
Set wb = Workbooks.Open(FS.FoundFiles(i))
'czy jest właściwy arkusz?
Set sh = Nothing
On Error Resume Next
Set sh = wb.Worksheets(SheetName)
On Error GoTo 0
If Not sh Is Nothing Then 'jeśli jest arkusz
'miejsce wstawienia danych = pierwszy wolny wiersz wg kolumny A
Set kom = shAct.Cells(Rows.Count, "A").End(xlUp)
If kom.Value <> "" Then Set kom = kom.Offset(1, 0)
w = 1 'kopiujemy od 1-go wiersza, chyba że
'są już jakieś dane (czyli jest już wkopiowany nagłówek)
If kom.Row > 1 Then
'i jeśli dane mają nagłówek
If IsDataHeader Then w = 2
End If
'zakres kopiowany
With sh
Set rg = Intersect(.Cells(1, 1).CurrentRegion, _
.Range(.Cells(w, 1), .Cells(Rows.Count, Columns.Count)))
End With
'kopiowanie
rg.Copy kom
wynik = wynik + 1
End If
'zamknięcie skoroszytu
wb.Close False
Next i
Application.ScreenUpdating = True
Application.EnableEvents = True
ReadDataFromSheets = wynik
End Function
Powodzenia.
Dopisane po chwili: sprawdź ile razy użyłem select. |
|
|
napisał: damianel
postów: 35
umieszczony:
14 sierpnia 2008
09:10
|
|
| ma wkejac do tego samego arkusza |
|
|
napisał: lukejohnr84
postów: 21
umieszczony:
14 sierpnia 2008
08:03
|
|
| Cytat: Widze ze walnoles jakies makro, ale program musi pobierac sciezki dostepu do skoroszytow z ktorych chce skopiowac arkusze no i musi pobierac nzwy arkusz ktore chce skopiowac, Pomozcie
Dzieki
jesli dobrze zrozumialem, to chcesz, zeby makro przeszukiwalo katalogi, szukalo w nich plikow .XLS, otwieralo je, szukalo w nich arkuszy "mis", jesli znajdzie takowy arkusz to kopiuje jego zawartosc do pliku docelowego(przy nastepnym znalezionym arkuszu "mis" kopiuje do tego samego pliku docelowego - w ten sam arkusz mis, dorzucajac dane, czy do nowego arkusza w pliku docelowym, np. "mis2"?)
jesli jest tak, jak napisalem, to Ci nie potrafie pomoc 
jesli chodzi o samo wyszukiwanie sciezek - jak juz otworzysz jakis plik uzyj funkcji CurDir - zwraca ona obecna sciezke
sprecyzuj zadanie |
|
|
napisał: damianel
postów: 35
umieszczony:
13 sierpnia 2008
15:44
|
|
Widze ze walnoles jakies makro, ale program musi pobierac sciezki dostepu do skoroszytow z ktorych chce skopiowac arkusze no i musi pobierac nzwy arkusz ktore chce skopiowac, Pomozcie
Dzieki |
|
|
napisał: lukejohnr84
postów: 21
umieszczony:
13 sierpnia 2008
13:56
|
|
zacznijmy od tego, ze w jednym pliku excela nie mozesz miec dwoch arkuszy o takiej samej nazwie
co do kopiowania:
Sub aaa()
Sheets("mis1").Select
Range("A1:IV65536").Select
'Selection.End(xlDown).Select
Selection.Copy
'#####################
'plus opcjonalna zmiana pliku
'#####################
Sheets("mis2").Select
'Cells(1, 1).Select
Range("A1:IV65536").Select
Selection.PasteSpecial
End Sub |
|
|
napisał: damianel
postów: 35
umieszczony:
13 sierpnia 2008
12:54
|
|
| Hej dajcie jakies wskazowki jak skopiowac np wszystki arkusze o nazwie "mis" z roznych skoroszytow do jednego skoroszytu, tak ze w tym jednym skoroszycie mam wszystki arkusze o nazwie mis |
|
|
 wstecz 1 dalej  wszystkich stron: 1
|
|
dane.zip