Skocz do zawartości


Close Open
Close Open
Zdjęcie
- - - - -

Transfer danych do Excel !!


  • Please log in to reply
8 replies to this topic

#1 Kreskowy

Kreskowy

    Początkujący

  • Forumowicze
  • PipPipPip
  • 67 Postów:
  • Płeć:Mężczyzna
  • Lokalizacja:Warszawa, Polska

Napisany 07 marzec 2008 - 16:02

Witam

Mam mały problem. Wiec tak. Chce zaimportować pojedyncze wartosci z innych plików xls do jednego nowego arkusza zbiorczego. Z Katalogu np C:\Ankieta\


Import miałby polegać na tym ze wybieramy katalog gdzie znajduja sie wszystkie pliki w ktorych zawarte sa dane potrzebne do importu. Kazdy z tych plikow jest zbudowany tak samo tzn ze np. w komorce A2 w kazdym z plikow bedzie dana potrzebna do zaimporotowania do nowego arkusza zbiorczego do komorki A2 dla wszystkich plikow xls w przykladowym katalogu. W komorce powiedzmy H8 bedzie kolejna dana potrzebna do zaimportowania z kazdego kolejnego pliku w katalogu do komorki B2(obok danej zapisanej w komorce A2).

Chcialbym zeby kazda kolejny zaimportowany plik zapisywal sie w kolejnych wierszach powiedzmy od 2 do konca bazy w xls

Kazdy plik w katalogu C:\Ankieta\ budowe ma taka sama kwetsia tylko roznych danych wprowadzonych w kazdym kolejnym z plikow.(jest to arkusz ankiety)

Chcialbym zeby nowy plik xls zawieral zestawienie wszystkich tych danych zebranych w kolejnych wierszach (kazdy wiersz to import kolejnego pliku z katalogu C:\Ankieta\)

Oczywiscie Chcialbym zeby w komorkach np. A1 wpisala sie nazwa kolumny np. Imie w B1 Ocena a dopiero pod tymi nazwami byly imporotowane dane ktore beda zgodne z zaimportowanymi wartosciami wypelnionych ankiet.


Imie Ocena
Pawel 4
Rafal 7

itd


to jest tylko przyklad bo ankieta jest bardziej rozbudowana. Chodzi mi tylko o wzor ktory pomoze mi zestawic wszyskie potrzebne mi dane w jednym pliku i arkuszu xls


Moja wiedza (programowanie VBA) jest troche za mala jak na ten problem, dlatego licze na pomoc forumowiczow

Pozdrawiam

#2 birds22

birds22

    Entuzjasta

  • Forumowicze
  • PipPipPipPipPipPipPip
  • 1332 Postów:
  • Płeć:Mężczyzna
  • Lokalizacja:Zduńska Wola

Napisany 07 marzec 2008 - 17:48

A podpowiedź w postaci linku do rozwiązania podobnego problemu wystarczy ?

http://forum.idg.pl/...howtopic=134750

#3 Koziorozec

Koziorozec

    Master

  • Forumowicze
  • PipPipPipPipPipPipPip
  • 1461 Postów:
  • Płeć:Nie podano

Napisany 07 marzec 2008 - 18:19

I jeszcze tutaj:

http://www.coderscit...sutra91608.html
Zadając pytanie w poście napisz CO chcesz zrobić, a nie JAK - to ułatwi znalezienie rozwiązania!

Dołącz do swojego postu plik z przykładowymi REPREZENTACYJNYMI danymi, na których będzie można sprawdzić rozwiązanie.
Opisz wszystkie warunki i zależności.
Bazę Accessa należy skompaktować (menu Narzędzia->Narzędzia bazy danych->Kompaktuj i napraw bazę danych).

Koziorozec pomógł Ci w życiu? ;) - odwdzięcz się odpowiednim komentarzem w jego Profilu.

#4 Kreskowy

Kreskowy

    Początkujący

  • Forumowicze
  • PipPipPip
  • 67 Postów:
  • Płeć:Mężczyzna
  • Lokalizacja:Warszawa, Polska

Napisany 07 marzec 2008 - 23:00

I jeszcze tutaj:

http://www.coderscit...sutra91608.html




Wielkie dzieki to juz cos. Ale i tak mam jeszcze kilka pytan. Zanim dane beda kopiowane chcialbym zeby kazda kolumna miala swoj tytul np A1 Imie B1 Nazwisko C1 Data itd a dopiero pozniej ma nastapic kopiowanie danych z odpowiednich komorek pozostalych plikow. Chcialbym np zeby dane nie byly kopiowane od wiersza 1 a np. od 2 pod tytulami kolumn.Takie opracowanie pomogloby mi do zebrania gotowych danych w jednym arkuszu pod kazda z nazwanych kolumn.

I jeszcze jedna uwaga: Wszystko sie ladnie kopiuje ale jezeli w jakiejs komorce z ktorej nastepuje transfer danych nie ma zadnej wartosci to w arkuszu do ktorego dane importujemy pojawia sie "0" jak tego uniknac? tak zeby nie pojawialo sie zero a pozostawala pusta komorka zgodnie z komorka z ktorej pobieramy jakas wartosc a w ktorej bylo puste pole?

Ale i tak juz jest cos:) Wielkie dzieki

#5 Koziorozec

Koziorozec

    Master

  • Forumowicze
  • PipPipPipPipPipPipPip
  • 1461 Postów:
  • Płeć:Nie podano

Napisany 08 marzec 2008 - 03:01

Zanim dane beda kopiowane chcialbym zeby kazda kolumna miala swoj tytul np A1 Imie B1 Nazwisko C1 Data itd a dopiero pozniej ma nastapic kopiowanie danych z odpowiednich komorek pozostalych plikow.

Nagłówki możesz mieć wcześniej zapisane, a w kodzie określić, że dane mają być wstawiane od wiersza drugiego.
Można też zrobić tak, że z kodu będą wstawiane nagłówki, a wtedy to nie będzie miało znaczenia, czy zrobisz to na początku kodu, czy na końcu.
Żeby nie kombinować z istniejącym moim makrem, można dodać na końcu dodawanie pustego wiersza przed pierwszym wierszem i wypełnianie nagłówków odpowiednimi tekstami.

jezeli w jakiejs komorce z ktorej nastepuje transfer danych nie ma zadnej wartosci to w arkuszu do ktorego dane importujemy pojawia sie "0" jak tego uniknac? tak zeby nie pojawialo sie zero a pozostawala pusta komorka zgodnie z komorka z ktorej pobieramy jakas wartosc a w ktorej bylo puste pole?

W moim rozwiązaniu, w którym chodziło o uniknięcie otwierania kolejnych skoroszytów, co mogłoby powodować wydłużoną pracę programu - może to być trudne, jak odróżnić zero wynikające z braku danych w jakimś skoroszycie, a zero, które tam faktycznie jest.
Jeśli zaś nie ma prawa być zer w źródłowych arkuszach i jeśli w zbiorczym się pojawią, co będzie oznaczać, że w źródle, w tym miejscu nie było danych, to sprawa jest prosta.

Uzupełnienie procedury "Zbiorowka":
1) Na początku modułu deklarujemy potrzebne zmienne:
'Do podmiany zer na pustą komórkę.
Dim kom As Range

'Określenie ostatniego wypełnionego wiersza według kolumny A.
Dim lngOstWypelnionyWiersz As Long
2) Na końcu procedury dopisujemy:
'Wymiana wartości zerowych na pustą komórkę.
	lngOstWypelnionyWiersz = Application.WorksheetFunction.CountA(ThisWorkbook.Worksheets(1).Range("A:A"))
	For Each kom In ThisWorkbook.Worksheets(1).Range("A1:C" & lngOstWypelnionyWiersz)
		kom.Value = WyrzucZero(kom.Value)
	Next kom

Dodatkowo dodajemy nową funkcję w module:
Function WyrzucZero(Wartosc As Variant) As Variant
'========================================================================
' Procedure   : WyrzucZero
' Version	 : 1.0
' Author	  : Koziorozec
' DateTime	: 2008-03-08 02:41
' Description : Funkcja zamienia zera na pustą komórkę, inne wartości
'			   zwraca takie, jakie są.
'========================================================================

	If Wartosc = 0 Then
		WyrzucZero = Empty 'można napisać, np. "brak" zamiast Empty.
	Else
		WyrzucZero = Wartosc
	End If

End Function

P.S.: Jeśli coś pokręcone jest, to przepraszam, ale "ździebko" późno :(
Zadając pytanie w poście napisz CO chcesz zrobić, a nie JAK - to ułatwi znalezienie rozwiązania!

Dołącz do swojego postu plik z przykładowymi REPREZENTACYJNYMI danymi, na których będzie można sprawdzić rozwiązanie.
Opisz wszystkie warunki i zależności.
Bazę Accessa należy skompaktować (menu Narzędzia->Narzędzia bazy danych->Kompaktuj i napraw bazę danych).

Koziorozec pomógł Ci w życiu? ;) - odwdzięcz się odpowiednim komentarzem w jego Profilu.

#6 Kreskowy

Kreskowy

    Początkujący

  • Forumowicze
  • PipPipPip
  • 67 Postów:
  • Płeć:Mężczyzna
  • Lokalizacja:Warszawa, Polska

Napisany 08 marzec 2008 - 09:35

Oke postaram sie to wyprobowac. Tzn poskladac cale zapytanie tak zeby dzialalo bez tych zer. A co tych tytulow kolumn to masz racje przygotuje sobie wczesniej arkusz i tylko zaczne zapisywac od drugiego wiersza... A powiesz mi gdzie to zmienic zeby tak wlasnie zapisywac? Po zlozeniu calego pytania przesle je na forum moze ktos bedzie mial okazje z niego skorzystac. P.S. Dobry jestes w te klocki:)

Dodano 08-03-2008 09:35:43:

Probowalem cos z tym zrobic ale cos nie idzie. Czy jest szansa zeby poskladac cale zapytanie ktore bylo w linku razem z twoimi wskazowkami? moze cos zle robie chcialbym porownac.. Oczywiscie chodzi mi o to zeby uniknac zer i o zapisywanie od 2 wiersza.. Do tego czasu bede dalej dzialac..

#7 Kreskowy

Kreskowy

    Początkujący

  • Forumowicze
  • PipPipPip
  • 67 Postów:
  • Płeć:Mężczyzna
  • Lokalizacja:Warszawa, Polska

Napisany 09 marzec 2008 - 18:30

Zeby zapisywac od drugiego wiersza wystaraczy zmienic ten fragment :

.Cells(i + 1, 1).FormulaLocal = "='" & folderspec & "[" & fl.Name & "]" & ArkNazwa & "'!" & Kom1
.Cells(i + 1, 2).FormulaLocal = "='" & folderspec & "[" & fl.Name & "]" & ArkNazwa & "'!" & Kom2
.Cells(i + 1, 3).FormulaLocal = "='" & folderspec & "[" & fl.Name & "]" & ArkNazwa & "'!" & Kom3

Wazne zeby dopisac + 1 a bedzie zapisywac od 2 wiersza co do uniekniecia zer nadal mam problemy.

#8 Koziorozec

Koziorozec

    Master

  • Forumowicze
  • PipPipPipPipPipPipPip
  • 1461 Postów:
  • Płeć:Nie podano

Napisany 09 marzec 2008 - 19:54

Zeby zapisywac od drugiego wiersza wystaraczy zmienic ten fragment :
.Cells(i + 1, 1).FormulaLocal = "='" & folderspec & "[" & fl.Name & "]" & ArkNazwa & "'!" & Kom1
[...]
Wazne zeby dopisac + 1 a bedzie zapisywac od 2 wiersza co do uniekniecia zer nadal mam problemy.

Zaraz, zaraz. Trochę tak, a trochę nie, poprawnie będzie wcześniej nadać wartość i = 1, wtedy w powyższej części nic nie trzeba zmieniać.

Całościowy kod, z poprawkami:
1) Wpisywanie wartości od drugiej linii,
2) Wypełnianie nagłówków kolumn - w pierwszym wierszu,
3) Wymienianie zawartości komórek z zer na puste.

Nowe fragmenty oznaczone ---.

Sub Zbiorowka()
'========================================================================
' Procedure   : Zbiorowka
' Version	 : 2.0
' Author	  : Koziorozec
' DateTime	: 2008-03-09 19:30
' Description : Zbiera informacje z różnych komórek wielu plików do jednego
'			   skoroszytu. UWAGA! Wszystkie skoroszyty muszą mieć taką samą
'			   nazwę arkusza lub taką samą pozycję wśród innych arkuszy.
'========================================================================
'Jeśli w plikach, w określonych komórkach nie będzie
'danych, to wystąpi błąd, a więc poniższa linijka:
'w przypadku wystąpienia błędu, pomija go (jeśli na początku nie będzie apostrofu).
'On Error Resume Next

'Katalog, w którym znajdują się wszystkie
'pliki Excela z danymi do ściągnięcia.
Const folderspec As String = "C:\TEMP\bleble\"

'Stała określająca nazwę arkusza z danymi w każdym pliku.
Const ArkNazwa As String = "Arkusz1"

'Stałe tekstowe określające, w których komórkach są dane.
Const Kom1 As String = "A2"
Const Kom2 As String = "B5"
Const Kom3 As String = "G18"

'Do obiektu FileSystemObject.
Dim fs, f, fc, fl
'Licznik pętli dla kolejnych wierszy.
Dim i As Long

'Do podmiany zer na pustą komórkę.
Dim kom As Range

'Określenie ostatniego wypełnionego wiersza według kolumny A.
Dim lngOstWypelnionyWiersz As Long

	'Utworzenie zmiennej obiektowej wskazującej na obiekt FileSystemObject.
	Set fs = CreateObject("Scripting.FileSystemObject")
	'Odniesienie do naszego katalogu ze skoroszytami wyciągów.
	Set f = fs.GetFolder(folderspec)
	'fc - kolekcja plików w ww. katalogu.
	Set fc = f.Files

'---Wypełnienie trzech komórek pierwszego wiersza nagłówkami kolumn.
	With ThisWorkbook.Worksheets(1).Range("A1:C1")
		'Wypełnienie komórek nagłówkami.
		.Value = Array("Nazwisko", "Imię", "Wartość")
		'Nadanie koloru o indeksie 44 - ciemny żółty.
		.Interior.ColorIndex = 44
		'Pogrubienie czcionki.
		.Font.Bold = True
	End With

'---Początkowa wartość i = 1, dzięki czemu zaczniemy od wiersza drugiego.
	i = 1

	'Dla każdego pliku w kolekcji...
	For Each fl In fc
		'Jeżeli plik zawiera w nazwie "wyciag"...
		If InStr(1, fl.Name, "wyciag") Then
			'Zwiększ licznik o 1.
			i = i + 1
			With ThisWorkbook.Worksheets(1)
				'Do pierwszych trzech kolumn wpisujemy formułę odwołania
				'do odpowiednich komórek w kolejnym pliku.
				.Cells(i, 1).FormulaLocal = "='" & folderspec & "[" & fl.Name & "]" & ArkNazwa & "'!" & Kom1
				.Cells(i, 2).FormulaLocal = "='" & folderspec & "[" & fl.Name & "]" & ArkNazwa & "'!" & Kom2
				.Cells(i, 3).FormulaLocal = "='" & folderspec & "[" & fl.Name & "]" & ArkNazwa & "'!" & Kom3
			End With
		End If
		'Następny plik.
	Next fl

	'UWAGA!
	'Być może przyda się zostawić odniesienia do komórek w innych skoroszytach,
	'to poniższa część nie będzie potrzebna.

	'---Początek---
	With ThisWorkbook.Worksheets(1).Range("A:C")
		'Autodopasowanie kolumn do ich zawartości.
		.Columns.AutoFit
		'Kopiujemy zakres A:C do Schowka...
		.Copy
		'...i wklejamy specjalnie, jako wartości.
		.PasteSpecial Paste:=xlPasteValues
		'Czyścimy Schowek.
		Application.CutCopyMode = False
		'Żeby odznaczyć zaznaczenie A:C - wybieramy komórkę A1.
		.Cells(1).Select
	End With
	'---Koniec-----

'---Wymiana wartości zerowych na pustą komórkę.
	lngOstWypelnionyWiersz = Application.WorksheetFunction.CountA(ThisWorkbook.Worksheets(1).Range("A:A"))
	For Each kom In ThisWorkbook.Worksheets(1).Range("A1:C" & lngOstWypelnionyWiersz)
		kom.Value = WyrzucZero(kom.Value)
	Next kom

End Sub

'-----------------------------------------------------------

Function WyrzucZero(Wartosc As Variant) As Variant
'========================================================================
' Procedure   : WyrzucZero
' Version	 : 1.0
' Author	  : Koziorozec
' DateTime	: 2008-03-08 02:40
' Description : Funkcja zamienia zera na pustą komórkę, inne wartości
'			   zwraca takie, jakie są.
'========================================================================

	If Wartosc = 0 Then
		WyrzucZero = Empty 'można napisać, np. "brak" zamiast Empty.
	Else
		WyrzucZero = Wartosc
	End If

End Function

Zadając pytanie w poście napisz CO chcesz zrobić, a nie JAK - to ułatwi znalezienie rozwiązania!

Dołącz do swojego postu plik z przykładowymi REPREZENTACYJNYMI danymi, na których będzie można sprawdzić rozwiązanie.
Opisz wszystkie warunki i zależności.
Bazę Accessa należy skompaktować (menu Narzędzia->Narzędzia bazy danych->Kompaktuj i napraw bazę danych).

Koziorozec pomógł Ci w życiu? ;) - odwdzięcz się odpowiednim komentarzem w jego Profilu.

#9 Kreskowy

Kreskowy

    Początkujący

  • Forumowicze
  • PipPipPip
  • 67 Postów:
  • Płeć:Mężczyzna
  • Lokalizacja:Warszawa, Polska

Napisany 09 marzec 2008 - 22:00

Suppppppppeeeeeeeerrrrrrrrrr rewelacja dziala :) Nie wiem jak mam Ci dziekowac ulatwi mi to prace :) Skacze z radosci :)




0 Użytkowników czyta ten temat

0 użytkowników, 0 gości, 0 anonimowych użytkowników