Excel Forum - Porady, Pomoc,  Excel Help, Excel FAQ Strona Główna
 FAQ  RegulaminRegulamin  Szukaj   Użytkownicy   Grupy   Rejestracja   Profil   Twoje wiadomości   Zaloguj 


Poprzedni temat «» Następny temat
ID tematu: 12354 Skopiuj do schowka Funkcja GetValue
Autor Wiadomość
Tajan


Pomógł: 4463 razy
Posty: 9907
Wysłany: 15-05-2009, 14:52   Funkcja GetValue

W wątku: http://www.excelforum.pl/viewtopic.php?t=12349 pojawił sie problem użycia powszechnie stosowanej funkcji GetValue, służącej do pobierania danych z zamkniętych skoroszytów, jako funkcji arkusza. Niestety, ze względu na zastosowanie w niej makr typu XLM, funkcja tak zastosowana nie działa.
Pomyślałem, że można by było spróbować wykorzystac do tego celu ADO. Na razie wyszło mi takie coś:
Kod:
Function ADOGetValue(path As String, file As String, sheet As String, ref As String)
' =ADOGetValue(p;f;s;r)
' p - scieżka
' f - nazwa pliku
' s - nazwa arkusza
' r - komórka lub obszar np. "A3", "A1:A10"

    Dim arg As String
    Dim nRowCount As Long, nColCount As Long
    Dim nActRow As Long, nActCol As Long
    Dim ArrVal() As Variant
    Dim xArray As Variant
    Dim xValue As Variant
   
    Dim oCn As Object, oRs As Object
   
    If Right(path, 1) <> "\" Then path = path & "\"
   
    If Dir(path & file) = "" Then
        'brak pliku ...
        ADOGetValue = CVErr(2042)
        Exit Function
    End If
   
    Set oCn = CreateObject("ADODB.Connection")
   
    oCn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
           "Data Source=" & path & file & ";" & _
           "Extended Properties=""Excel 8.0;HDR=NO;IMEX=1;"""
   
    arg = "select * from [" & sheet & "$" & ref & _
          IIf(InStr(ref, ":") = 0, ":" & ref, "") & "]"
         
    Set oRs = CreateObject("ADODB.Recordset")
   
    oRs.Open arg, oCn, 3
   
    xArray = oRs.getRows
       
    nRowCount = UBound(xArray, 2)
    nColCount = UBound(xArray, 1)
   
    ReDim ArrVal(1 To nRowCount + 1, 1 To nColCount + 1)
   
    For nActRow = 0 To nRowCount
       
        For nActCol = 0 To nColCount
           
            xValue = xArray(nActCol, nActRow)
           
            If IsNumeric(xValue) Then
               xValue = CDbl(xValue)
            ElseIf IsNull(xValue) Then
               xValue = Empty
            End If
           
            ArrVal(nActRow + 1, nActCol + 1) = xValue
       
        Next
   
    Next

    ADOGetValue = ArrVal
   
    oRs.Close
    oCn.Close
   
    Set oRs = Nothing
    Set oCn = Nothing
   
End Function


Wprawdzie nie testowałem jej zbyt intensywnie, ale chyba działa! :-) Wszystkie parametry - tekstowe. Może być użyteczna, gdy zachodzi potrzeba skorzystania np. z funkcji ADR.POŚR, ale skoroszyt źródłowy jest zamknięty, więc trzeba uciekać się do innych sposobów.
Zapraszam do testowania. Pewne wady już zauważyłem i spróbuję je naprawić w późniejszym terminie. Na razie czekam na wasze opinie.
ID posta: 65004 Skopiuj do schowka
 
 
tkuchta1 
Excel Expert



Pomógł: 1749 razy
Posty: 2888
Wysłany: 02-11-2009, 16:30   

Tajan Wielki SZACUN i podziękowania za tą funkcję. W paru formułach już wykorzystywałem i wszystkie Importy danych XL2XL bez otwierania pliku źródłowego opierałem o trzewia tej funkcji :-)

Co zauważyłem - i proponuję poprawić to treść ConnectionString'a wg Wersji Excela.
Kod:
    Dim strConnectionString As String
    '...
   
    If Val(Application.Version) < 12 Then
        strConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                              "Data Source=" & path & file & ";" & _
                              "Extended Properties=""Excel 8.0;HDR=NO;IMEX=1;"""
    Else
        strConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                              "Data Source=" & path & file & ";" & _
                              "Extended Properties=""Excel 12.0;HDR=NO;IMEX=1;"""
    End If
    oCn.Open strConnectionString

po tej zmianie podanie w arg.file "zeszyt.xlsm" czy "Zeszyt.xlsx" nie zwróci błędu.

Hej. :-)
_________________
Tomek



Moja Stronka
A po co ten Excel
Ostatnia aktualizacja: 2015-09-04
ID posta: 76519 Skopiuj do schowka
 
 
Tajan


Pomógł: 4463 razy
Posty: 9907
Wysłany: 02-11-2009, 21:08   

tkuchta1, jest super :-)
ID posta: 76545 Skopiuj do schowka
 
 
Marecki 
Excel Expert



Wersja: Win Office 2019
Pomógł: 2203 razy
Posty: 7275
Wysłany: 10-08-2013, 13:50   

W związku z tym, iż nie wszystkie osoby potrafią wprowadzić sugestię Tomka, dlatego też poniżej zamieszczam funkcję Tajana z uwzględnioną "poprawką":
Kod:
Function ADOGetValue(path As String, file As String, sheet As String, ref As String)
' =ADOGetValue(p;f;s;r)
' p - scieżka
' f - nazwa pliku
' s - nazwa arkusza
' r - komórka lub obszar np. "A3", "A1:A10"

    Dim arg As String
    Dim nRowCount As Long, nColCount As Long
    Dim nActRow As Long, nActCol As Long
    Dim ArrVal() As Variant
    Dim xArray As Variant
    Dim xValue As Variant
    Dim strConnectionString As String
    Dim oCn As Object, oRs As Object

    If Right(path, 1) <> "\" Then path = path & "\"

    If Dir(path & file) = "" Then
        'brak pliku ...
        ADOGetValue = CVErr(2042)
        Exit Function
    End If

    Set oCn = CreateObject("ADODB.Connection")

    If Val(Application.Version) < 12 Then
        strConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                              "Data Source=" & path & file & ";" & _
                              "Extended Properties=""Excel 8.0;HDR=NO;IMEX=1;"""
    Else
        strConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                              "Data Source=" & path & file & ";" & _
                              "Extended Properties=""Excel 12.0;HDR=NO;IMEX=1;"""
    End If
    oCn.Open strConnectionString
    arg = "select * from [" & sheet & "$" & ref & _
          IIf(InStr(ref, ":") = 0, ":" & ref, "") & "]"

    Set oRs = CreateObject("ADODB.Recordset")

    oRs.Open arg, oCn, 3

    xArray = oRs.getRows

    nRowCount = UBound(xArray, 2)
    nColCount = UBound(xArray, 1)

    ReDim ArrVal(1 To nRowCount + 1, 1 To nColCount + 1)

    For nActRow = 0 To nRowCount

        For nActCol = 0 To nColCount

            xValue = xArray(nActCol, nActRow)

            If IsNumeric(xValue) Then
                xValue = CDbl(xValue)
            ElseIf IsNull(xValue) Then
                xValue = Empty
            End If

            ArrVal(nActRow + 1, nActCol + 1) = xValue

        Next

    Next

    ADOGetValue = ArrVal

    oRs.Close
    oCn.Close

    Set oRs = Nothing
    Set oCn = Nothing

End Function


P/S
Temat zamykam.
W przypadku gdy ktoś niższy rangą chciałby wnieść coś nowego do tematu , funkcji, proszony jest o kontakt z Administratorem lub Moderatorem forum.
_________________
Hardware - ta część komputera, którą można kopnąć kiedy software przestanie funkcjonować.

Szkolenia z Excela , FB
Office 2019 Professional Plus , Windows 10 x64
Pozdrawiam, były mkkk23 teraz Marecki.
ID posta: 202397 Skopiuj do schowka
 
 
Artik 



Wersja: Win Office 365
Pomógł: 2699 razy
Posty: 8949
Wysłany: 23-04-2014, 17:58   

Jest problem.

Kiedy nazwa arkusza zaczyna się od spacji otrzymuję błąd o nieprawidłowych nawiasach :shock:

Jak to obejść, bo nie mam wpływu na nazwę arkusza?

Artik
_________________
Persistence is a virtue in the world of programming.
ID posta: 224772 Skopiuj do schowka
 
 
Marecki 
Excel Expert



Wersja: Win Office 2019
Pomógł: 2203 razy
Posty: 7275
Wysłany: 23-04-2014, 18:15   

Artik nie mam jak sprawdzić, ale może pomoże dodanie apostrofów -coś jak w tym temacie http://www.excelforum.pl/...rof%2A+spacj%2A
_________________
Hardware - ta część komputera, którą można kopnąć kiedy software przestanie funkcjonować.

Szkolenia z Excela , FB
Office 2019 Professional Plus , Windows 10 x64
Pozdrawiam, były mkkk23 teraz Marecki.
ID posta: 224775 Skopiuj do schowka
 
 
Artik 



Wersja: Win Office 365
Pomógł: 2699 razy
Posty: 8949
Wysłany: 23-04-2014, 20:15   

Już próbowałem, ale być może w złych miejscach wstawiałem.

Artik
_________________
Persistence is a virtue in the world of programming.
ID posta: 224785 Skopiuj do schowka
 
 
hudibyk 
Excel Expert



Pomógł: 361 razy
Posty: 1111
Wysłany: 23-04-2014, 20:36   

Wczoraj trafiłem na jakąś stronę (myślę, że pomogłoby) ale za cholerę nie mogę jej znaleźć. Coś mi się kojarzy, że musisz kombinować z nazwą pliku w nawiasach kwadratowych
_________________
Hudibyk
ID posta: 224788 Skopiuj do schowka
 
 
Artik 



Wersja: Win Office 365
Pomógł: 2699 razy
Posty: 8949
Wysłany: 24-04-2014, 01:08   

Przeprowadziłem dalsze badania raczej metodą prób i błędów.

1. Jeżeli arkusz ma nazwę "Ala ma kota" (czyli akceptowalna przez ADO), a w powyższym kodzie dołożę apostrofy:
Cytat:
arg = "SELECT * FROM ['" & sheet & "$'" & ref & _
IIf(InStr(ref, ":") = 0, ":" & ref, "") & "]"
to otrzymuję błąd:
Cytat:
Error -2147217865: Aparat bazy danych programu Microsoft Access nie może odnaleźć obiektu „'Ala ma kota$'C6:F1019”. Upewnij się, że obiekt istnieje, a jego nazwa i ścieżka są podane poprawnie. Jeśli „'Ala ma kota$'C6:F1019” nie jest obiektem lokalnym, sprawdź połączenie sieciowe lub skontaktuj się z administratorem serwera.
Wygląda na to, że w tym przypadku nie można w zapytaniu użyć apostrofów.

2. Jeżeli arkusz ma nazwę " Ala ma kota" (spacja przed Ala), a w powyższym kodzie nic nie zmienię:
Cytat:
arg = "SELECT * FROM [" & sheet & "$" & ref & _
IIf(InStr(ref, ":") = 0, ":" & ref, "") & "]"
to otrzymuję błąd:
Cytat:
Error -2147217900: Niewłaściwe nawiasy w nazwie ' Ala ma kota$C3:K5773'.


Jak bym się nie zakręcił, to zawsze d... z tyłu. :-(

3. Natomiast nie ma problemu, by spacja(-e) występowała(-Y) na końcu nazwy arkusza.

Przypomnę, że nie mam wpływu na nazwy arkuszy.

:help

Artik
ID posta: 224802 Skopiuj do schowka
 
 
Marecki 
Excel Expert



Wersja: Win Office 2019
Pomógł: 2203 razy
Posty: 7275
Wysłany: 24-04-2014, 09:31   

Znalazłem taki zapis:
Cytat:
Standardowe konwencje nazewnictwa.
Zestaw reguł dotyczących nazewnictwa obiektów DAO.
Nazwy mogą mieć do 64 znaków i mogą zawierać dowolną kombinację liter, cyfr, spacji i znaków specjalnych oprócz kropki (.), wykrzyknika (!), lewostronnego apostrofu (`) i nawiasów kwadratowych ([ ]). Dodatkowo na początku nazwy nie można używać spacji, a także znaków sterujących (o wartościach ASCII od 0 do 31).

Choć cytat odnosi się do DAO, to przypuszczam że mogło to być przeniesione ( ta spacja) do ADO i chyba się tego nie przeskoczy.
Pozostanie metoda tradycyjna - otwarcie pliku, pobranie danych, zamknięcie.
_________________
Hardware - ta część komputera, którą można kopnąć kiedy software przestanie funkcjonować.

Szkolenia z Excela , FB
Office 2019 Professional Plus , Windows 10 x64
Pozdrawiam, były mkkk23 teraz Marecki.
ID posta: 224824 Skopiuj do schowka
 
 
Artik 



Wersja: Win Office 365
Pomógł: 2699 razy
Posty: 8949
Wysłany: 24-04-2014, 09:50   

Marecki napisał/a:
Dodatkowo na początku nazwy nie można używać spacji
Trochę kłamałem z tym:
Cytat:
że nie mam wpływu na nazwy arkuszy.
:-)
W filozofii działania jest moment gdzie skoroszyt jest otwarty, bo użytkownik musi wskazać konkretną kolumnę (nie da się kodem jej zidentyfikować). Widzę, że będę musiał w tym momencie ostrzec gościa, że nazwa arkusza jest nieakceptowalna i za jego zgodą ewentualnie nazwę zmienić. Chciałem tej operacji uniknąć, ale widać mus to mus.

Dzięki Marecki. :danke

Artik
ID posta: 224829 Skopiuj do schowka
 
 
frytek1986
świeżak


Posty: 1
Wysłany: 28-01-2015, 11:21   

A mnie funkcja ADOGetValue działa, ale tylko w przypadku gdy plik z którego zasysam jest otwary (działa jak adr.pośr).. jak go zamkne to dostaje #ARD

Czym to może być spowodowane?

Musze doprecyzować. Nie działa dla plików .csv Dla tego samego pliku zapisanego jako xlsx działa. Można to jakoś poprawić?
ID posta: 251402 Skopiuj do schowka
 
 
Artik 



Wersja: Win Office 365
Pomógł: 2699 razy
Posty: 8949
Wysłany: 28-01-2015, 15:19   

Plik csv ma całkiem inną strukturę niż xls. To tylko plik tekstowy, w którym dane są oddzielone separatorami. Gdy otwierasz plik csv za pomocą Excela, program ten automatycznie dokonuje konwersji do pliku xls. Dlatego można odnieść wrażenie, że struktura csv jest taka jak xls. Ale wystarczy otworzyć csv w notatniku i już widać że tak nie jest.

Chcąc pobierać dane z csv należy użyć innego sterownika. Więcej znajdziesz tutaj, zwróć szczególną uwagę na fragment od So How Do I Use ADO to Query a Text File?.

Artik
ID posta: 251473 Skopiuj do schowka
 
 
guziolek
Starszy Forumowicz


Posty: 37
Wysłany: 24-01-2017, 14:11   

Chyba jestem jakiś upośledzony, bo nigdzie nie widzę gdzie w kodzie powinienem wpisać te argumenty
Kod:
p - scieżka
' f - nazwa pliku
' s - nazwa arkusza
' r - komórka lub obszar np. "A3", "A1:A10"


Orłem jakimś nie jestem jeśli chodzi o VBA, nawet amatorem można powiedzieć, ale zawsze raczej doszukiwałem się metodą prób i błędów gdzie i co wpisać, ale tutaj nie mam pojęcia.
ID posta: 313840 Skopiuj do schowka
 
 
apollo
ExcelSpec


Pomógł: 1240 razy
Posty: 4328
Wysłany: 24-01-2017, 15:02   

Chcesz pobrać dane z zamkniętego pliku? Chyba tak skoro pytasz w tym temacie. W takim razie w pewnym momencie, gdzieś w kodzie, będziesz wywołał funkcję ADOGetValue, prawda? No ale funkcja wymaga 4 parametrów wejściowych, więc przy wywołaniu musisz podać te 4 parametry, prawda? Bo inaczej funkcja ADOGetValue będzie pytała: "Z której komórki (z którego obszaru) którego arkuszu w którym pliku na jakiej ścieżce mam pobrać dane, miszczu? Z koszu pod numerem 9 przy ul. ABC w mieście XYZ?"
Kod:

Dim Arr
...
Arr = ADOGetValue(konkretna ścieżka, konkretna nazwa pliku, konkretna nazwa arkuszu, konkretny obszar)
sprawdzanie zwrócanych danych i używanie
ID posta: 313844 Skopiuj do schowka
 
 
Wyświetl posty z ostatnich:   
Odpowiedz do tematu
Nie możesz pisać nowych tematów
Nie możesz odpowiadać w tematach
Nie możesz zmieniać swoich postów
Nie możesz usuwać swoich postów
Nie możesz głosować w ankietach
Nie możesz załączać plików na tym forum
Możesz ściągać załączniki na tym forum
Dodaj temat do Ulubionych
Wersja do druku

Skocz do:  

Powered by phpBB modified by Przemo © 2003 phpBB Group
Theme xandgreen created by spleen& Programosy modified v0.3 by warna
Opieka techniczna www.marketingNET.pl

Archiwum

Strona używa plików cookies.

Kliknij tutaj, żeby dowiedzieć się jaki jest cel używania cookies oraz jak zmienić ustawienia cookie w przeglądarce.
Korzystając ze strony użytkownik wyraża zgodę na używanie plików cookies, zgodnie z bieżącymi ustawieniami przeglądarki.
Sprawdź, w jaki sposób przetwarzamy dane osobowe