Jak na práci s polem v EXCELU?

[atari]

Mám dva listy: List1 a List2

Vždy ve sloupci "A" je název řádku (je to číslo) v obou listech.

Potřebuji z Listu2 překopírovat hodnoty se sloupců "C" a "D" do Listu1 opět do sloupců "C" a "D", ale vždy do řádku se stejnýn názvem.
Viz vzor v příloze (první dva řádky z Listu2 jsem překopíroval do Listu1 červeně pro ukázku).

Jde o to, že řádky jsou různě zpřeházené, je jich několik stovek, a operace se velmi často opakuje.

Na netu jsem to nenašel. Stačil by mi nějaký podobný vzor, něbo poradit kudy na to, a už si to pak dodělám. S polem ve VBA moc neumím. Děkuji

[Reklama]

[Grimm]

Třeba takto, kód sem nekomentoval. Věřím, že to není potřeba.

Edit:
Vyměněná příloha
Přidal sem kód, který pracuje se dvěma poli.

Dodatečně přidáno po 2 hodinách 35 minutách 29 vteřinách:
Ještě sem přidal třetí variantu - dvě pole bez cyklu.
Můžeš otestovat co bude rychlejší.

[atari]

V noci jsem to jen vyzkoušel.

"Sub Dopln_hodnoty()" ten fungoval na testu. Ten "Sub Dopln_hodnoty2()" však po spuštění neudělal nic.
Ale na první pohled ta první varianta je pro mě srozumitelnější na úpravy pro moje originální data. (Těch sloupců mám víc a řádků také).
Komentář asi není potřeba. Jenom se na to musím v klidu podívat a pochopit jak ty pole fungují s těmi příkazy LBound a Ubound.

Teď jsem vyzkoušel i "Sub Dopln_hodnoty3()", ale ta také po spuštění nic neudělá na tom "test Excel.xlsm"

O víkendu se k tomu dostanu, abych to upravil na moje data. Tak pak dám vědět, co je rychlejší (pokud tedy rozchodím tu variantu 2 a 3).

[Grimm]

Tak sem si stáhl sešit z mé odpovědi a všechny varianty jsou funkční viz přiložený soubor.
Jedná se o video *.mp4, které je zabalené do *.zip, protože jinak se mi nechtělo přiložit.

Jinak příkazy LBound a UBound by se daly přeložit jako min a max.
LBound(Pole) vrátí počáteční rozměr, tedy 1 (nebo 0, záleží jak je pole vytvořené) a UBound(Pole) vrací horní hranici, tedy pokud do pole uložíš 20 položek, UBound vrátí hodnotu 20.

[elninoslov]

Jednoduchšie na pochopenie bude asi vloženie vzorca a preplácnutie hodnotou, bez cyklu:

Kód: Vybrat vše

Sub Dopln_hodnoty4()
Dim MaxRadek1 As Long, MaxRadek2 As Long

    MaxRadek2 = List2.Cells(Rows.Count, 1).End(xlUp).Row
    If MaxRadek2 < 4 Then MsgBox "Žádná data na Listu2", vbExclamation, "Varování": Exit Sub

    MaxRadek1 = List1.Cells(Rows.Count, 1).End(xlUp).Row
    If MaxRadek1 < 4 Then
        MsgBox "Žádná data na Listu1", vbExclamation, "Varování": Exit Sub
        Else
        With List1.Range("C4:D4").Resize(MaxRadek1 - 3)
            .Formula = "=IFERROR(VLOOKUP($A4,'" & List2.Name & "'!$A$4:$D$" & MaxRadek2 & ",COLUMN(C4),FALSE),"""")"
            .Value = .Value
        End With
    End If
End Sub

Ak pôjde o naozaj veľa zdrojových stĺpcov, tak potom pole s cyklom (pretože XXX tisíc VLOOKUP tiež trvá), a ak o veľmi veľa vyhľadávaní tak by som si tipol, že vytvorenie kolekcie s kľúčom bude najrýchlejšie. Ak bude treba dorobím.

EDIT: Doplnil som narýchlo aj tú kolekciu ...

Kód: Vybrat vše

Sub Dopln_hodnoty5()
Dim MaxRadek1 As Long, MaxRadek2 As Long, i As Long, IDX As Long
Dim Col As Collection, Pole(), Zdroj()

    MaxRadek2 = List2.Cells(Rows.Count, 1).End(xlUp).Row
    If MaxRadek2 < 4 Then MsgBox "Žádná data na Listu2", vbExclamation, "Varování": Exit Sub Else Zdroj = List2.Range("A4:D4").Resize(MaxRadek2 - 3).Value

    MaxRadek1 = List1.Cells(Rows.Count, 1).End(xlUp).Row
    If MaxRadek1 < 4 Then MsgBox "Žádná data na Listu1", vbExclamation, "Varování": Exit Sub
    If MaxRadek1 = 4 Then ReDim Pole(1 To 1, 1 To 1): Pole(1, 1) = List1.Range("A4").Value Else Pole = List1.Range("A4").Resize(MaxRadek1 - 3).Value

    Set Col = New Collection
    ReDim Preserve Pole(1 To UBound(Pole, 1), 1 To 2)
   
    On Error Resume Next
    For i = 1 To UBound(Zdroj, 1)
        If Not IsEmpty(Zdroj(i, 1)) Then Col.Add i, CStr(Zdroj(i, 1))
    Next i
   
    If Err.Number <> 0 Then Err.Clear: MsgBox "Zdrojový seznam na " & List2.Name & " obsahuje duplicity." & vbNewLine & "Zachovány byly pouze první hodnoty.", vbExclamation, "Varování"
   
    For i = 1 To UBound(Pole, 1)
        If Not IsEmpty(Pole(i, 1)) Then
            IDX = Col(CStr(Pole(i, 1)))
            If Err.Number = 0 Then
                Pole(i, 1) = Zdroj(IDX, 3): Pole(i, 2) = Zdroj(IDX, 4)
            Else
                Pole(i, 1) = Empty
                Err.Clear
            End If
        End If
    Next i
    On Error GoTo 0
   
    List1.Range("C4:D4").Resize(MaxRadek1 - 3).Value = Pole
   
    Set Col = Nothing
End Sub

[atari]

Grimm:
1. funguje podle zadání

2. varianta překopíruje všechny sloupce, a tím mě změní sloupec B, což je nežádoucí (kde mám například vzorce a formátování), takže tu jsem ani dál nezkoumal

3. varianta to samé, také překopíruje všechny sloupce, a také změní sloupec B.

Jak jsem to pochopil, tak ve všech variantách se pro každý kopírovaný sloupec musí přidat řádek kódu.
Je možné aby to makro kopírovalo i vzorce, případně formátování?

elninoslov:
1. varianta je jednoduchá, dokážu si tam nastavit svoje sloupce, ale má dvě vady. Když je buňka prázdná, tak tam dosadí nulu. A kopíruje jenom hodnoty - když tam je vzorec, tak překopíruje jen výsledek.

2. varianta funguje dobře (kopíruje vzorce a do prázdných buněk nulu nedává). Jenom si neumím nastavit svoje sloupce. Je možné nějak jednoduše měnit rozsah těch kopírovaných sloupců (třeba L až P apod.)?

A to kopírování formátování buněk je také možné?

A ještě doplnění, zda je možné aby se vždy také zkopírovaly první tři řádky každého sloupce z C1,C2,C3 z List2 na C1,C2,C3 z List1, a takto vždy u každého kopírovaného sloupce?

[elninoslov]

Len pre úplnosť upravím makrá na kopírovanie HODNÔT.
1. varianta - teda makro "Dopln_hodnoty4":
upravené na odstránenie 0 pri prázdnych bunkách, a možnosť ľahkej zmeny stĺpcov. Stĺpec L z List2 dá do L v List1, ...

2. varianta - teda makro "Dopln_hodnoty5":
rovnako upravená na možnosť ľahkej zmeny stĺpcov, ale rozhodne nekopíruje vzorce !!!

Kód: Vybrat vše

Sub Dopln_hodnoty4()
Dim MaxRadek1 As Long, MaxRadek2 As Long, Adresa As String, Prvy As String, OBL As Range, VZOREC As String

Const STLPCE_DAT As String = "L:P"

    MaxRadek2 = List2.Cells(Rows.Count, 1).End(xlUp).Row
    If MaxRadek2 < 4 Then MsgBox "Žádná data na Listu2", vbExclamation, "Varování": Exit Sub
   
    With List2
        Set OBL = .Range(STLPCE_DAT)
        Adresa = .Range("A4").Resize(MaxRadek2 - 3, OBL.Columns(OBL.Columns.Count).Column).Address(True, True)
        Prvy = .Cells(4, OBL.Columns(1).Column).Address(False, False)
        VZOREC = Replace("=IFERROR(IF(?="""","""",?),"""")", "?", "VLOOKUP($A4,'" & .Name & "'!" & Adresa & ",COLUMN(" & Prvy & "),FALSE)")
    End With
   
    MaxRadek1 = List1.Cells(Rows.Count, 1).End(xlUp).Row
    If MaxRadek1 < 4 Then MsgBox "Žádná data na Listu1", vbExclamation, "Varování": Exit Sub
    With List1.Range(Prvy).Resize(MaxRadek1 - 3, OBL.Columns.Count)
        .Formula = VZOREC
        .Value = .Value
    End With
End Sub

Kód: Vybrat vše

Sub Dopln_hodnoty5()
Dim MaxRadek1 As Long, MaxRadek2 As Long, i As Long, y As Integer, s As Integer, IDX As Long, Z As Integer, K As Integer
Dim Col As Collection, Pole(), Zdroj()

Const STLPCE_DAT As String = "L:P"

    MaxRadek2 = List2.Cells(Rows.Count, "A").End(xlUp).Row
    If MaxRadek2 < 4 Then MsgBox "Žádná data na Listu2", vbExclamation, "Varování": Exit Sub
    Z = List2.Range(STLPCE_DAT).Column
    K = Z + List2.Range(STLPCE_DAT).Columns.Count - 1
    Zdroj = List2.Range("A4").Resize(MaxRadek2 - 3, K).Value

    MaxRadek1 = List1.Cells(Rows.Count, "A").End(xlUp).Row
    If MaxRadek1 < 4 Then MsgBox "Žádná data na Listu1", vbExclamation, "Varování": Exit Sub
    If MaxRadek1 = 4 Then ReDim Pole(1 To 1, 1 To 1): Pole(1, 1) = List1.Range("A4").Value Else Pole = List1.Range("A4").Resize(MaxRadek1 - 3).Value

    Set Col = New Collection
    ReDim Preserve Pole(1 To UBound(Pole, 1), 1 To K - Z + 1)
   
    On Error Resume Next
    For i = 1 To UBound(Zdroj, 1)
        If Not IsEmpty(Zdroj(i, 1)) Then Col.Add i, CStr(Zdroj(i, 1))
    Next i
   
    If Err.Number <> 0 Then Err.Clear: MsgBox "Zdrojový seznam na " & List2.Name & " obsahuje duplicity." & vbNewLine & "Zachovány byly pouze první hodnoty.", vbExclamation, "Varování"
   
    For i = 1 To UBound(Pole, 1)
        If Not IsEmpty(Pole(i, 1)) Then
            IDX = Col(CStr(Pole(i, 1)))
            If Err.Number = 0 Then
                s = 0
                For y = Z To K
                    s = s + 1
                    Pole(i, s) = Zdroj(IDX, y)
                Next y
            Else
                Pole(i, 1) = Empty
                Err.Clear
            End If
        End If
    Next i
    On Error GoTo 0
   
    List1.Cells(4, Z).Resize(MaxRadek1 - 3, UBound(Pole, 2)).Value = Pole
   
    Set Col = Nothing
End Sub

Nikde v zadaní nevidím požiadavku kopírovania vzorcov a formátov. To je ošemetná vec. Nevieme aké to sú vzorce, kam odkazujú, ako ich kopírovanie zmení.
Kopírovanie formátu je ešte násobne horšie. Odhliadnuc od pomalosti môžu nastať rôzne eventuality. Aký je tam formát? Orámovanie, písmo, pozadie, farebný prechod, pruhy, podmienený formát (na čom záleží?), formát hodnoty (mena, percentá, desatiny, text, ...) ... ?
Trochu to rozveďte, upresnite, priložte lepšiu prílohu s príkladom.

[atari]

Za ty vzorce se omlouvám. Já jsem to udělal pomocí cyklu FOR - NEXT příkazem COPY za použití RESIZE, viz kód níže. Je to sice velmi pomalé, ale velmi jednoduché. Projdu cyklem všechny řádky, a jedním příkazem se vše překopíruje tam kam má. A kopíruje to také vzorce a formátování. Proto jsem to v zadání zapomněl zdůraznit, protože mě to nenapadlo.

Tento jednoduchý způsob má však jednu vadu. Pokud je na Listu1 ve sloupci A vložená prázdná buňka, tak ty kopírované řádky dále jsou o jeden posunuté, protože příkaz RESIZE tohle ošetřit neumí. A to jsem nedokázal vyřešit.

Vzorce jsou nutné a týkají se vždy jen stejného řádku, a při překopírování se nezmění – viz ukázka.

Ty formáty jsou různé, orámování, písmo, pozadí, barevný přechod, hodnoty, i desetinná čísla, a někdy podmíněný formát. Pokud by s tím byl problém, tak to oželím, a vždy to pak překopíruji ručně.

V příloze posílám ukázku dat jak vypadají ty kopírované sloupce na Listu2. V ukázce to je sl. (K:S)

Kód: Vybrat vše

radek_c = 4 - 1
posun = Sloupec_konec - Sloupec_zacatek
For radek = 4 To 1740
   If wsList2.Cells(radek, 1) = "" Then 'když je prázdný tak nekopíruji
   Else
      p = wsList2.Cells(radek, 1) 'číslo ze sloupce A, určuje pořadí v cíli také sloupec A
      wsList2.Cells(radek, Sloupec_zacatek).Resize(1, posun + 1).Copy _
      wsList1.Cells(radek_c + p, Sloupec_zacatek)
   End If
Next radek

[elninoslov]

Tak potom takto. Kopírovanie formátov je možné jedine takto pomaly.

Kód: Vybrat vše

Sub Dopln_hodnoty6()
Dim Radku1 As Long, Radku2 As Long, i As Long, RADEK2 As Range, RADEK1 As Range, DEL As Range, IDX, Pole1(), Pole2()

Const SLOUPCE_DAT As String = "K:S"     'které sloupce dat z List2 se budou kopírovat
Const RADKY_HLAVICKY As String = "1:3"  'které řádky hlavičky z List2 se budou kopírovat
Const PRVNI_RADEK As Long = 4           'číslo řádku na kterém začínají data na List1 a List2
Const URCUJICI_SLOUPEC As String = "A"  'sloupec ve kterém jsou na List1 hledané hodnoty a na List2 prohledávané hodnoty


    Radku2 = wsList2.Cells(Rows.Count, URCUJICI_SLOUPEC).End(xlUp).Row - PRVNI_RADEK
    If Radku2 < 1 Then MsgBox "Žádná data na listu " & wsList2.Name, vbExclamation, "Varování": Exit Sub
    If Radku2 = 1 Then ReDim Pole2(1 To 1, 1 To 1): Pole2(1, 1) = wsList2.Cells(PRVNI_RADEK, URCUJICI_SLOUPEC).Value Else Pole2() = wsList2.Cells(PRVNI_RADEK, URCUJICI_SLOUPEC).Resize(Radku2).Value
    Set RADEK2 = wsList2.Range(SLOUPCE_DAT).Rows(PRVNI_RADEK - 1)   'oblast nad 1. řádkem dat v List2 (odtud půjde Offset pro Copy)
   
    Radku1 = wsList1.Cells(Rows.Count, URCUJICI_SLOUPEC).End(xlUp).Row - PRVNI_RADEK
    If Radku1 < 1 Then MsgBox "Žádná data na listu " & wsList1.Name, vbExclamation, "Varování": Exit Sub
    If Radku1 = 1 Then ReDim Pole1(1 To 1, 1 To 1): Pole1(1, 1) = wsList1.Cells(PRVNI_RADEK, URCUJICI_SLOUPEC).Value Else Pole1() = wsList1.Cells(PRVNI_RADEK, URCUJICI_SLOUPEC).Resize(Radku1).Value
    Set RADEK1 = wsList1.Range(SLOUPCE_DAT).Rows(PRVNI_RADEK - 1)   'oblast nad 1. řádkem dat v List1 (odtud půjde Offset pro Destination)
   
    Application.ScreenUpdating = False
   
    With Intersect(wsList2.Range(SLOUPCE_DAT), wsList2.Range(RADKY_HLAVICKY))   'kopírování hlavičky z List2 do List1
        .Copy wsList1.Range(.Address)
    End With
   
    For i = 1 To Radku1
        Application.StatusBar = "Spracování řádku " & i & " / " & Radku1
        DoEvents
        If Not IsEmpty(Pole1(i, 1)) Then
            IDX = Application.Match(Pole1(i, 1), Pole2, 0)          'nalezení indexu hledané hodnoty v prohledávaném poli (sloupci v List2)
            If Not IsError(IDX) Then RADEK2.Offset(IDX, 0).Copy RADEK1.Offset(i, 0) 'kopírování řádku dané oblasti
        Else
            If DEL Is Nothing Then Set DEL = RADEK1.Offset(i, 0) Else Set DEL = Union(DEL, RADEK1.Offset(i, 0)) 'když je prázdné označ daný řádek v List1 na smazání (pro případ předešlých dat)
        End If
    Next i
   
    If Not DEL Is Nothing Then DEL.Clear                            'smazat staré data v daných sloupcích v prázdných řádkách
   
    Application.StatusBar = False
    Application.ScreenUpdating = True
End Sub

Prípadne si kód rozložte viac vertikálnejšie (If/Then/Else a pod.), ja keď je to funkčný celok, tak si to dám na čo najmenej riadkov, aby mi to nezavadzalo, len sa potom kód zle číta. Ak to neviete, tak to upravím.

Nastavuje sa to úplne jednoducho - konštanty a ich význam je jasný.

EDIT: Aj tak mi tento Váš systém kopírovania (alebo Vami požadovaný systém) nedá pokoja. Tie formáty a vzorce sa predsa týkajú vždy celých stĺpcov, nie? Aj keď by ste tie zdrojové/cieľové stĺpce stále menil, máte predsa asi nejaké stĺpce stále napr. A:XX, a z toho si vyberáte ktoré chcete kopírovať, napr. K:S. V tých stĺpcoch ale predsa nemeníte formáty a vzorce tak, že by v tom istom stĺpci boli iné formáty na rôznych riadkoch, alebo v riadkoch iné vzorce. Vzorce sú len adaptívne vzhľadom na daný riadok. Prečo by sa potom nemohlo urobiť rýchle kopírovania a spracovávanie iba rýchlych polí dát, vkladanie rýchlych polí dát, keď zdrojové a cieľové formáty a vzorcové stĺpce sú stále rovnaké???

[atari]

Je to super, funguje to skvěle, velmi děkuji. Jenom to mazání starých dat je zbytečné, ale může to tam být. Já vždy ty sloupce v Listu1 vymažu a pak do nich kopíruji.

Jen taková otázka. Kdybych si zápis RANGE předělal na Cells, bude mě to korektně fungovat?

Ano je to přesně tak. V Listu2 se vzorce vždy vytvoří na řádku 4 (nebo 5,6) a potom se jenom myší zkopírují na celý sloupec. Takže v každém sloupci je vždy stejný vzorec. Někdy je však použit „$“, takže pak je v celém sloupci v každém vzorci tento odkaz: C$1.
A to samé je s formátováním. Je vždy stejné na celý sloupec (kromě prvních třech řádků).

Dodatečně přidáno po 22 minutách 19 vteřinách:
Tak jsem si rozebral celý kód, a nepochopil jsem poslední příkaz: „If Not DEL Is Nothing Then DEL.Clear“
Jak pozná, že má mazat jen ty řádky, které jsou ve sloupci „A“ prázdné, s které sloupce?

[atari]

Tak jsem si z toho ještě udělal druhou verzi kdy RANGE definuji přes Cells a funguje to.
Už jsem to pochopil, i to DEL jak funguje. Je to jenom pole …

Ještě jednou díky