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

VBA - Kopiowanie zakresów

karumov 28 Kwi 2016 11:28 690 13
  • #1 28 Kwi 2016 11:28
    karumov
    Poziom 6  

    Witam,
    mam za zadanie jak najszybsze skopiowanie z kilkunastu arkuszy jednego pliku excela do jednego arkusza innego (nowo utworzonego) pliku excela.
    Używam metody

    Zrodla = Split("A1,A2,...,V2:W2", ",")
    Cele = Split("C9,C10,...,L103", ",")
    For i = LBound(Zrodla) To UBound(Zrodla)
    Workbooks(CurrentFile).Sheets(1).Range(Zrodla(i)).Copy
    ThisWorkbook.Sheets("XXX").Range(Cele(i)).PasteSpecial Paste:=xlPasteAll
    Next i

    i tak dla każdego arkusza z ThisWorkbook. Makro działa w miarę szybko dopóki nie dochodzi do skopiowania większego zakresu ("j2:n5000").
    Problem w tym, że w tym zakresie zazwyczaj jest po kilka-kilkadziesiąt wypełnionych komórek a znaczna większość jest pusta. np. komórki do skopiowania mieszczą się w zakresach ("j2:k200"), ("L3:L50"),("L60:L110"), oczywiście za każdym razem zakresy są inne.
    W jaki sposób skopiować tylko wypełnione komórki? (same wartości liczbowe)
    Może jest szybszy/lepszy sposób kopiowanie od przedstawionego przeze mnie? oczywiście wyłączenie odświeżania ekranu i manualne przeliczanie plików uwzględniam.

    0 13
  • #3 28 Kwi 2016 12:55
    karumov
    Poziom 6  

    Jeżeli to podpowiedź to nie rozumiem.

    Liczby źródeł i celów a makrze zgadzają się zawsze,
    w źródłach mogę kopiować zarówno jedną komórkę jaki i cały zakres przylegających komórek, w celach wystarczy dać jedną komórkę i zakresy wklejają się adekwatnie.

    Problem polega na tym że nie wiem ile komórek będzie wymagało skopiowania i gdzie one będą się znajdować dlatego kopiuje cały obszar ("j2:n5000").

    0
  • #4 28 Kwi 2016 18:36
    Prot
    Poziom 31  

    karumov napisał:


    Zrodla = Split("A1,A2,...,V2:W2", ",")
    Cele = Split("C9,C10,...,L103", ",")
    For i = LBound(Zrodla) To UBound(Zrodla)
    Workbooks(CurrentFile).Sheets(1).Range(Zrodla(i)).Copy
    ThisWorkbook.Sheets("XXX").Range(Cele(i)).PasteSpecial Paste:=xlPasteAll
    Next i



    Funkcja Split dzieli Twoje stringi na substringi jak widać na obrazku

    VBA - Kopiowanie zakresów

    Jeśli nie zachowasz pewnej symetrii działań (operacji kopiuj - wklej poszczególnych komórek i zakresów komórek) to wskaźniki tablic mogą się rozjechać, a podajesz jeden wspólny wskaźnik "i". :cry:

    Na konkretnym arkuszu można by dokładniej przeanalizować to makro.

    Zakres komórek jaki podajesz w Zrodla generalnie winien być obojętny (jeśli zachowujesz dla całego wyrażenia format string rozdzielany przecinkami), ale kopiując tak duże zakresy w całości do jednego arkusza możesz chyba zbliżyć się do ograniczeń excela (ilość wierszy i kolumn).

    0
  • #5 28 Kwi 2016 19:26
    JRV
    Specjalista - VBA, Excel

    karumov napisał:
    nie wiem ile komórek będzie wymagało skopiowania i gdzie one będą się znajdować dlatego kopiuje cały obszar

    a wiesz gdzie one będą się znajdować w celach ? tak samo ("j2:n5000")?

    0
  • #6 02 Maj 2016 09:22
    karumov
    Poziom 6  

    JRV - komórki z kolumny j muszą być przeniesione do BB2:BB5001, mogą być przeniesione z usunięciem pustych komórek. Np jeżeli kopiuje tylko J5, J10, J15 mogę je skopiować do komórek "BB2:BB4". Mogę też do BB5,BB10,BB15, muszą być w kolumnie BB, a cyfry nie mają znaczenia(przynajmniej tak mi się wydaje).
    Komórki z ("k2:n5000") do ("BC:BF") z takimi zastrzeżeniami jak wcześniej.

    Prot- umiem napisać makro które działa, na kwestiach takich czym się różni string od substringa się nie znam. Makro działa poprawnie, struktura plików jest taka że cele kopiują się zawsze w odpowiednie miejsca, potem sczytuje je z powrotem do pliku z którego wyszły i są w odpowiednich miejscach. Sposób znalazłem w internecie i działa poprawnie, jeżeli znasz lepszy/szybszy to napisz albo podrzuć link do źródła, ale dzięki za komentarz.

    Najlepszym sposobem byłoby użycie znajdź i zaznacz niepuste a potem skopiuj, ale w excelu nie da się skopiować nieprzylegających zakresów. Chyba że z poziomu VBA jest jakiś sposób.

    0
  • Pomocny post
    #7 02 Maj 2016 09:38
    JRV
    Specjalista - VBA, Excel

    Kod: vb
    Zaloguj się, aby zobaczyć kod

    0
  • #8 06 Maj 2016 09:06
    karumov
    Poziom 6  

    Dzięki, chociaż timer excela twierdzi że wykorzystanie Twojego pomysłu dla mojego arkusza nie przyspiesza działania makra, zostawię jak jest.
    Od razu napiszę inną sprawę, może będziesz mógł pomóc.
    Zrobiłem przycisk w excelu, chcę żeby miał jedno działanie przechodzenie na tryb manualny jeżeli użytkownikiem nie jest Kowalski.

    If LCase(Environ("UserName")) <> "Kowalski" Then Application.Calculation = xlManual
    i fajnie działa ale jak chce obok Kowalskiego postawić Malinowskiego

    If LCase(Environ("UserName")) <> "Kowalski" or LCase(Environ("UserName")) <> "Malinowski" Then Application.Calculation = xlManual
    wtedy zawsze przechodzi na tryb manualny.
    Nie bardzo wiem w przym problem.

    0
  • #9 06 Maj 2016 09:12
    JRV
    Specjalista - VBA, Excel

    LCase("AaBbCc") = "aabbcc"
    UCase("AaBbCc") = "AABBCC"
    If LCase(Environ("UserName")) <> "kowalski" And LCase(Environ("UserName")) <> "malinowski"

    0
  • #10 06 Maj 2016 09:32
    karumov
    Poziom 6  

    Całe makro:

    Sub nn()
    If LCase(Environ("UserName")) <> "kowalski" And LCase(Environ("UserName")) <> "malinowski" Then
    Application.Calculation = xlManual
    End If
    End Sub

    po użyciu zostaje automatyczny tryb.
    Na pewno "AND", logicznie rzecz biorąc użytkowanik nie może być malinowskim i kowalskim jednocześnie?

    0
  • #11 06 Maj 2016 10:02
    JRV
    Specjalista - VBA, Excel

    a tak?
    If (LCase(Environ("UserName")) <> "kowalski" And LCase(Environ("UserName")) <> "malinowski" )Then

    Dodano po 11 [minuty]:

    Automatyczny ma byc tylko dla Kowalskiego i Malinowskiego?
    Dla kontroli dodaj przed 'Application.Calculation = xlManual '
    Msgbox Environ("UserName")
    Jest w nazwiskach znaki ć ę ł ń ś itp.?

    0
  • #12 06 Maj 2016 10:37
    karumov
    Poziom 6  

    makro
    If (LCase(Environ("UserName")) <> "kowalski" And LCase(Environ("UserName")) <> "malinowski" )Then
    też nie pomaga.
    Msgbox pokazuje kowalski - także username jest na pewno dobrze wpisany.

    Automatyczny ma być dla 4 osób, nie występują ć ę ł ń ś, same polskie, klawiaturowe litery.
    Może być możliwość że nie ma takiej możliwości?

    0
  • Pomocny post
    #13 06 Maj 2016 11:02
    JRV
    Specjalista - VBA, Excel

    karumov napisał:
    same polskie, klawiaturowe

    Ś, Ź, Ć, itp. - jest to polskie, wstaw w VBA - jak wyświetla?
    Latwiej porownanie userName na arkuszu(działa Unicode)
    np. If Application.CountIf(Range("users"), Lcase(Environ("UserName")))=0 Then Application.Calculation = xlManual

    users - nazwa zakresu gdzie te 4 osoby, np. Z1:Z4

    0
  • #14 06 Maj 2016 11:26
    karumov
    Poziom 6  

    Działa!
    If Application.CountIf(Range("G3:G6"), LCase(Environ("UserName"))) = 0 Then
    Application.Calculation = xlManual
    End If
    Dzięki wielkie.

    0