Elektroda.pl
Elektroda.pl
X
Proszę, dodaj wyjątek dla www.elektroda.pl do Adblock.
Dzięki temu, że oglądasz reklamy, wspierasz portal i użytkowników.

Zamiana kropki na przecinek w kwerendzie importowanej do excela

04 Sty 2012 21:12 3414 10
  • Poziom 8  
    Witam,
    po raz kolejny dziś stanąłem przed ścianą. Mam problem z danymi które ściąga mi makro z kwerendą. W liczbach jest kropka oddzielająca całości od dziesiętnych co uniemożliwia mi ich obróbkę. Wymyśliłem sobie coś takiego co załączyłem poniżej. A więc kwerenda wrzuca mi dane w zakres komórek A2:C20 ja to kopiuję niżej i po skopiowaniu zamieniam kropkę na kropkę jak to ktoś gdzieś trafnie ujął. To wszystko dzieje się w arkuszu 0dane0. Zależy mi na tym, aby ta operacja nie była widoczna dla oka gdyż zasadniczo chce ukryć ten arkusz a odpowiednie wyciągnięte dane przeglądać w innym. Dodatkowo dane muszę odświeżać co 30 sek i na bieżąco obrabiać. Jak widzicie jako że jestem laikiem :( nic ciekawego nie wymyśliłem a i to nie działa poprawnie ( makro kończy na zamianie na przecinki ale na arkuszu z danymi i zaczyna zaznaczanie na innym arkuszu gdy nie jestem na 0dane0)

    Wielka prośba o pomoc, być może macie inne pomysły.

    Sub dane()
    '
    ' dane Makro
    '


    Range("A2:C20").Select
    Sheets("0dane0").Select
    Application.Run "'makro.xls'!Kurs"
    Selection.Copy
    Range("A25").Select
    Sheets("0dane0").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Selection.Replace ".", "."

    Application.OnTime Now() + TimeValue("00:00:30"), "dane"

    End Sub
  • Moderator Programowanie
    Zdaje się, że trzeba zmienić kolejność. Najpierw Sheets().select, a następnie zakres.
    A z tym ukrywaniem jakoś nie mogę zaskoczyć. Chodzi o wyłączenie odświeżania (Application.Screenupdating)? Możesz jaśniej?
  • Poziom 8  
    Po prostu planuje ukryć manualnie cały arkusz do którego spływają dane z kwerendy, gdyż zależy mi aby nikt tam nie zaglądał, ale chciałbym aby to odświeżanie danych odbywało się w tle. To znaczy żeby nie wyskakiwał arkusz z danymi i żeby się nie zaznaczał na monitorze bo gdy go chcę teraz ukryć to pojawia się błąd.
  • Moderator Programowanie
    Rozumiem, że makro "Kurs" w pliku "makro.xls" pobiera jakieś kursy (walut?) przez kwerendę www. Przepisz co potrzeba do swojego arkusza bez "select", "copy", "paste" przez zwykłe przypisanie...
  • Poziom 8  
    adamas_nt dziekuję Ci bardzo za podpowiedzi, zamieniłem kolejność i wykorzystałem Application.Screenupdating i okazała sie bardzo pomocna :)
    Tak, makro Kurs pobiera kursy przez kwerendę www. Wszystko wyglądało by w miarę niezle oprócz problemu takiego że gdy mam otwarty inny plik excell to wyskakuje mi bład "Run-time error '1004': Pobranie właściwosci Select klasy Worksheet nie jest możliwe", mimo tego ze starałem się przypisać w makrze dokładną sciezkę z nazwą pliku do którego ma się odnosić. Coś tu jest nie tak.

    Co masz na myśli pisząc o zwykłym przypisaniu bez select, copy i paste.


    Sub dane()
    '
    ' dane Makro
    '
    Application.ScreenUpdating = False

    Workbooks("makro.xls").Worksheets("0dane0").Select
    Range("A2:C20").Select
    Application.Run "'makro.xls'!Kurs"
    Selection.Copy
    Workbooks("makro.xls").Worksheets("0dane0").Select
    Range("A25").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Selection.Replace ".", "."
    Workbooks("makro.xls").Worksheets("wyniki").Select

    Application.OnTime Now() + TimeValue("00:00:30"), "dane"

    End Sub
  • Poziom 40  
    wg mnie ten błąd można poprawić zmieniając w paru miejscach select na activate
    Nie znam też kodu "Kurs" Czy musi być dla "niego" zaznaczenie A2:C20

    Sub dane()
    '
    ' dane Makro
    '
    Application.ScreenUpdating = False

    Workbooks("makro.xls").Worksheets("0dane0").Activate
    Range("A2:C20").Select ' tu jeżeli nie ma to wpływu na makro KURS zostawił bym Range("A2").Select
    Application.Run "'makro.xls'!Kurs"
    Range("A2:C20").Copy
    Workbooks("makro.xls").Worksheets("0dane0").Activate
    Range("A25").Select
    ActiveSheet.Paste

    ' tu jezeli dobrze rozumiem zamienił bym powyższe dwie linijki kodu
    ' na kod: Range("A25").Paste

    Application.CutCopyMode = False
    Selection.Replace ".", "."

    Workbooks("makro.xls").Worksheets("wyniki").Activate
    Application.OnTime Now() + TimeValue("00:00:30"), "dane"

    'i włączył bym odświeżanie
    Application.ScreenUpdating = True

    End Sub

    Aczkolwiek zamiast korzystać z makra przepisującego dane tak jak radzi kolega adamas wpisz kolejno w arkuszu 0dane0 (nie w makro ) w a25 "=a2" w b25 "=b2" c25 "=c2" zaznacz te trzu komórki i skopiuj w dól do 45 wiersza.
    Wtedy powyższe makro można bedzie ograniczyć:

    Sub dane()
    '
    ' dane Makro
    '
    Application.ScreenUpdating = False

    Workbooks("makro.xls").Worksheets("0dane0").Activate
    Range("A2").Select

    Application.Run "'makro.xls'!Kurs"

    Range("A2:C20").Replace ".", "."

    Workbooks("makro.xls").Worksheets("wyniki").Activate

    Application.OnTime Now() + TimeValue("00:00:30"), "dane"

    Application.ScreenUpdating = True

    End Sub
  • Poziom 8  
    marek003 dziękuję Ci bardzo za uwagi, bardzo mi pomogłeś. Zamiana Select na Activate usunęła problem. Drugi sposób rzeczywiście prostszy. Kombinuję tylko jeszcze nad jedną rzeczą bo gdy jestem w innym pliku excell w czasie odświerzania jestem automatycznie co 30 sek przeniesiony do pliku w którym działa makro. Czy można to jakoś zrobić tak żeby samo mnie nie przerzucało?
  • Poziom 40  
    Bo "zapętliłeś" co 30 s procedurę a ona właśnie aktywuje arkusze.
    gdyż przyjęto że coś musi być zaznaczane (select)


    Czy mógłbyś podać kod makra KURS Bo jeżeli on "potrzebuje" zaznaczonej komórki do wpisania danych to nie wiem czy się to da ominąć.

    Ale wydaje mi się że wystarczy w niewielkim stopniu zmienić kod makra Kurs i to wystarczy.
  • Poziom 8  
    Przesyłam poniżej kod Kursu

    Sub Kurs()
    '
    ' Kurs Makro
    '
    Dim wks As Worksheet

    Set wks = ThisWorkbook.Worksheets("0dane0")

    With wks
    On Error Resume Next
    .QueryTables(1).Delete
    On Error GoTo 0

    With .QueryTables.Add(Connection:= _
    "URL;http://..." _
    , Destination:=wks.Range("$A$1"))
    .Name = _
    "kursy.php"
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .BackgroundQuery = True
    .RefreshStyle = xlOverwriteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .WebSelectionType = xlSpecifiedTables
    .WebFormatting = xlWebFormattingNone
    .WebTables = "1"
    .WebPreFormattedTextToColumns = True
    .WebConsecutiveDelimitersAsOne = True
    .WebSingleBlockTextImport = False
    .WebDisableDateRecognition = False
    .WebDisableRedirections = False
    .Refresh BackgroundQuery:=False

    End With
    End With

    End Sub
  • Pomocny post
    Poziom 40  
    Jak najbardziej popraw to makro, nie będzie cię "przerzucało" i będzie działać nawet jak ukryjesz arkusz 0dane0 (właściwość Visable arkusza ustaw na 0).

    To co zmieniłem zaznaczyłem. Rozumiem że musisz dodać pełny adres źródła (nie wiem po co wykasowałeś ale twoja wola).

    Nie potrzebny jest teraz wcześniejszy kod makra dane kod kurs_2 sam załatwia wszystko razem z odświeżaniem.

    Sub Kurs_2()
    '
    ' Kurs Makro
    '
    Dim wks As Worksheet

    Set wks = Workbooks("makro.xls").Worksheets("0dane0")

    With wks

    On Error Resume Next
    .QueryTables(1).Delete
    On Error GoTo 0

    With .QueryTables.Add(Connection:= _
    "URL;http://..." _
    , Destination:= .Range("$A$1") )
    .Name = _
    "kursy.php"
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .BackgroundQuery = True
    .RefreshStyle = xlOverwriteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .WebSelectionType = xlSpecifiedTables
    .WebFormatting = xlWebFormattingNone
    .WebTables = "1"
    .WebPreFormattedTextToColumns = True
    .WebConsecutiveDelimitersAsOne = True
    .WebSingleBlockTextImport = False
    .WebDisableDateRecognition = False
    .WebDisableRedirections = False
    .Refresh BackgroundQuery:=False

    End With


    .Range("A2:C20").Replace ".", "."
    End With

    Application.OnTime Now() + TimeValue("00:00:30"), "Kurs_2"
    End Sub



    W załączeniu (dla innych z forum) przykład działający z tym że nie chciało mi się długo szukać i podstawiłem pierwszą lepszą stronę z kursami która niestety odświeżana jest w trakcie działania kantoru więc odświeżanie co pół minuty w chwili obecnej (19:10) traci sens niemniej jest.

    Oczywiście arkusz 0dane0 jest ukryty.

    Kod: vb
    Zaloguj się, aby zobaczyć kod
  • Poziom 8  
    marek003 jest idealnie, dziękuję Ci za poświęcony czas. Działa świetnie i to tego jeszcze uproszczone. Jeszcze raz dzięki !!
    Pozdrawiam.