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.
