3420


Eksportowanie zakresu do pliku tekstowego

**************************************************************

Sub ExportRange()

. . .

End Sub

**************************************************************

Procedura przedstawiona poniżej zapisuje dane z zaznaczonego zakresu komórek arkusza do pliku tekstowego w formacie CSV. Excel potrafi oczywiście bezpośrednio ekspor­tować dane do pliku w formacie CSV, ale w taki sposób można eksportować tylko całe arkusze, podczas gdy nasza procedura działa dla dowolnego, zaznaczonego obszaru arkusza.

Dim Filename

Filename = ActiveWorkbook.Path & "\" & "textfile.csv"

Open Filename For Output As #1

. . .

Close #1

**************************************************************

Praca z zaznaczenym obszarem komórek.

Dim r, c

For r = 1 To Selection.Rows.Count

For c = 1 To Selection.Columns.Count

. . .

Next c

Next r

**************************************************************

Do zapisania zawartości komórek wykorzystana została zmienna o nazwie Data.

Jeżeli komórka zawiera format liczbowy, zmienna jest przekształcana na liczbę. Dzięki tej czynności dane liczbowe nie zostaną zapisane ze znakami cudzysłowu.

Jeżeli komórka jest pusta, wartość jej właściwości Value wynosi 0. Z tego powodu kod sprawdza, czy komórki nie są puste (za pomocą funkcji IsEmpty) i wstawia pusty ciąg znaków zamiast wartości 0.

Data = Selection.Cells(r, c).Value

If IsNumeric(Data) Then Data = Val(Data)

If IsEmpty(Selection.Cells(r, c)) Then Data = ""

**************************************************************

W procedurze dwukrotnie wykorzystano funkcję Write #.

Pierwsza instrukcja kończy się średnikiem, a zatem sekwencja CR LF nie będzie zapisywana.

Dla ostatniej komórki w wierszu, w drugiej instrukcji Write #, nie użyto średnika, dzięki czemu następny zapis do pliku zostanie umieszczony w nowym wierszu.

If c <> Selection.Columns.Count Then

Write #1, Data;

Else

Write #1, Data

End If

**************************************************************

Na rysunku 1 przedstawiono przykładową zawartość pliku będącego wynikiem działania procedury.

0x01 graphic

0x01 graphic

Rysunek 1. Ten plik tekstowy został wygenerowany za pomocą kodu VBA

Skoroszyt z tym przykładem - Eksport-import.xlsm.

--------------------------------------------------------------------------------

Importowanie pliku tekstowego do zakresu

**************************************************************

Sub ImportRange()

. . .

End Sub

**************************************************************

Procedura odczytuje dane z pliku CSV utworzonego w poprzednim przykładzie

Dim Filename

Dim Data 'wiersz danych

Filename = ActiveWorkbook.Path & "\" & "textfile.csv"

Open Filename For Input As #1

If Err <> 0 Then `sprawdzanie błądów

MsgBox "Nie znaleziono pliku: " & Filename, vbCritical, "BŁĄD"

Exit Sub

End If

. . .

Do Until EOF(1)

Line Input #1, Data

. . .

Loop

. . .

Close #1

**************************************************************

Procedura zapisuje uzyskane z pliku CSV wartości do arkusza, rozpoczynając od aktyw­nej komórki.

Program odczytuje każdy znak i przetwarza wiersze danych w celu wyszu­kania przecinków oddzielających kolumny i usunięcia cudzysłowów przed zapisaniem danych do arkusza.

Dim r, c

Dim txt, Char

Dim i

. . .

r = 0

c = 0

txt = ""

. . .

For i = 1 To Len(Data)

Char = Mid(Data, i, 1)

If Char = "," Then 'przecinek

ActiveCell.Offset(r, c) = txt 'piszemy

c = c + 1 'następna cell

txt = ""

ElseIf i = Len(Data) Then 'koniec wiersza

'(

If Char <> Chr(34) Then txt = txt & Char 'Chr(34)<>", dodaem liczbę

')

ActiveCell.Offset(r, c) = txt 'piszemy

txt = ""

ElseIf Char <> Chr(34) Then

'Chr(34)<>" & i <> Len(Data)

txt = txt & Char 'zwiększamy string

End If

Next i

c = 0

r = r + 1

. . .

**************************************************************

Len Function.

Zwraca wartość zawierającą liczbę znaków w ciągu lub liczbę bajtów potrzebnych do przechowania.

Returns a Long containing the number of characters in a string or the number of bytes required to store a variable.

MyString = "ABc"

MyLen = Len(MyString)

' Returns 3 - 3 characters in the string

**************************************************************

Mid Function.

Funkcja VBA Mid jest odpowiednikiem Excelowej funkcji Fragment.Tekstu . Zwraca okreśłona argumentem liczbę znaków danego wyrażenia, licząc od określonego argumentem znaku.


Przykładowy zapis kodu moze wyglądać tak:

Public Function KawalekTekstu (MojTekst As String, _

MojStart As Long, IleZnakow As Long) As String

KawalekTekstu = Mid(MojTekst, MojStart, IleZnakow)

End Function

Returns a Variant (String) containing a specified number of characters from a string.

Part

Description

string

Required. String expression from which characters are returned. If string contains Null, Null is returned.

start

Required; Long. Character position in string at which the part to be taken begins. If start is greater than the number of characters in string, Mid returns a zero-length string ("").

length

Optional; Variant (Long). Number of characters to return. If omitted or if there are fewer than length characters in the text (including the character at start), all characters from the start position to the end of the string are returned.

MyString = "AbCdEfG"

MyNewString = Mid(MyString, 3, 4)

' Returns ""CdEf"

**************************************************************

Application.ScreenUpdating = False

Application.ScreenUpdating = True

Application.ScreenUpdating

Cudownym remedium na migotanie ekranu jest właściwość ScreenUpdating obiektu Application. Jeśli na początku makra przypiszemy tej właściwości wartość False, uzyskamy w ten sposób dwie rzeczy:

Zysk na szybkości wykonania wynika z faktu, że Excel nie będzie już musiał odświeżać ekranu za każdym razem, gdy napotka takie polecenia jak Select, Activate, LargeScroll, SmallScroll itp.

True if screen updating is turned on.

Remarks

Turn screen updating off to speed up your macro code. You won't be able to see what the macro is doing, but it will run faster.

Remember to set the ScreenUpdating property back to True when your macro ends.

**************************************************************

On Error Resume Next

**************************************************************

Procedura pokazana powyżej poradzi sobie z większością danych, ale ma pewną wadę: nie potrafi poprawnie przetwarzać danych zawierających przecinki lub znaki cudzysłowu. Dodatkowo zaimportowane daty będą otoczone znakami #, na przykład #2007-05-12#.

**************************************************************



Wyszukiwarka

Podobne podstrony:
3420
3420
3420
02 metody badań neurobiologiczne podłoże pamięciid 3420 ppt
3420
Califone 3420 Cassette
3420
3420
3420
3420
3420
Califone 3420 Cassette(1)
3420(1)
Instrukcja obsługi Electrolux ERN 3420

więcej podobnych podstron