Stĺpec BB nemá číslo 52 ale 54. Zmena na 4 miestach.
Ten list "Výsledek" tam netuším na čo máte. Asi z predošlých pokusov, tak ho odstráňte zo zošitu, aj zo zoznamu listov pre ignorovanie. A s tým súvisí ešte jedna úprava v makre.
Kód: Vybrat vše
If IgnR > 0 Then IgnL = IgnL & Join(WorksheetFunction.Transpose(.Cells(2, 54).Resize(IgnR).Value2), "•") & "•"
zmeňte Cells(2... na Cells(1..., ale teraz som si ešte uvedovil, že sa nedá transponovať jedna bunka (ak je iba 1 názov listu), takže nahraďte daný riadok za
Kód: Vybrat vše
If IgnR > 0 Then
If IgnR = 1 Then IgnL = IgnL & .Cells(2, 54).Value2 & "•" Else IgnL = IgnL & Join(WorksheetFunction.Transpose(.Cells(2, 54).Resize(IgnR).Value2), "•") & "•"
End If
A tu
Kód: Vybrat vše
If nIgnR > 0 Then wsDatabase.Cells(IgnR + 2, 54).Resize(nIgnR).Value = WorksheetFunction.Transpose(Split(nIgnL, "•"))
zmente to IgnR + 2 na IgnR + 1.
Lebo iba 1 je určite na vynechanie vždy, a to list Database (prepíšte tam v BB2 tiež to totaly_X na Database).
A tu
Kód: Vybrat vše
.Range(.Cells(1, 54), .Cells(Rows.Count, 54).End(xlUp)).Offset(3).ClearContents
zmente Offset(3) na Offset(2), tu je preto 2 lebo sa ráta aj BB1 s hlavičkou.
Inak medzi listy na ignorovanie sa všetky spracované dávajú automaticky.
Ak je 15 stĺpcov a nie 9, tak treba zmeniť v makre
Kód: Vybrat vše
ReDim Pole(1 To R, 1 To 9)
Pole = LO.DataBodyRange.Columns(1).Resize(R, 9).Value2
na
Kód: Vybrat vše
ReDim Pole(1 To R, 1 To 15)
Pole = LO.DataBodyRange.Columns(1).Resize(R, 15).Value2
Kúsok pod tým je
Kód: Vybrat vše
...Array(Pole(i, 1), Pole(i, 2), Pole(i, 3), Pole(i, 4), Pole(i, 5), Pole(i, 6), Pole(i, 7), Pole(i, 8), Pole(i, 9))...
tam treba doplniť až po 15, teda
Kód: Vybrat vše
...Array(Pole(i, 1), Pole(i, 2), Pole(i, 3), Pole(i, 4), Pole(i, 5), Pole(i, 6), Pole(i, 7), Pole(i, 8), Pole(i, 9), Pole(i, 10), Pole(i, 11), Pole(i, 12), Pole(i, 13), Pole(i, 14), Pole(i, 15))...
Ďalej je ešte jedno
Kód: Vybrat vše
ReDim Pole(1 To R, 1 To 9)
treba zmeniť opäť na
Kód: Vybrat vše
ReDim Pole(1 To R, 1 To 15)
a kúsok pod tým sa načíta výsledok, kde treba opäť doplniť priradenie pre ďalšie stĺpce po 15
Kód: Vybrat vše
Pole(i, 1) = C(0): Pole(i, 2) = C(1): Pole(i, 3) = C(2): Pole(i, 4) = C(3): Pole(i, 5) = C(4): Pole(i, 6) = C(5): Pole(i, 7) = C(6): Pole(i, 8) = C(7): Pole(i, 9) = C(8)
na
Kód: Vybrat vše
Pole(i, 1) = C(0): Pole(i, 2) = C(1): Pole(i, 3) = C(2): Pole(i, 4) = C(3): Pole(i, 5) = C(4): Pole(i, 6) = C(5): Pole(i, 7) = C(6): Pole(i, 8) = C(7): Pole(i, 9) = C(8): Pole(i, 10) = C(9): Pole(i, 11) = C(10): Pole(i, 12) = C(11): Pole(i, 13) = C(12): Pole(i, 14) = C(13): Pole(i, 15) = C(14)
Makro totiž nič nekopíruje, lebo by to bolo mimoriadne pomalé. Makro naraz načíta celé pole dát, urobí porovnania polí a kolekcií, ktoré sú interne v makre (mimo prístupu do listu) veľmi rýchle, a zase naraz zapíše všetky dáta na list. Žiadne kúskovanie a kopírovanie.
Posielam aj upravenú verziu, ale zmeny som popisoval pre Vašu potrebu, ak Vás ešte napadne, že je nepodstatné poskystnúť reálne rozloženie.