Pri plneni ostrymi daty doslo k jedne podstatne situaci, ktera mi nabourala pripravenou proceduru; a to:
list1!Axx:Bxx muze tez obsahovat hodnotu "allA" pro sloupec A:A a "allB" pro sloupec B:B.
Hodnota allA je zastupny znak pro mnozinu vsech dat, ktera mohou byt pouzita v list1!Axx a jejichz seznam je definovan v list3!Axx
Hodnota allB je zastupny znak pro mnozinu vsech dat, ktera mohou byt pouzita v list1!Bxx a jejichz seznam je definovan v list3!Bxx
Soucasna procedura dokaze vyhodnotit a doplnit do odpovidajichch radku data pri shode obou sloupcu v list1!Axx:Bxx a list2!Axx:Bxx.
Pochopitelne nedochazi k prenosu dat z list1 do list2 v pripadech, kdy je hodnotou zastupny znak allA, nebo allB.
Potreboval bych jeste poradit jak se vyporadat s timto problemem.
Prikladam opet konkretni priklad.
Vytvoril jsem proceduru ktera mi naplni list2 vsemi moznymi kombinacemi dat z list3 (uvedomuji si, ze zatim je procedura nedokonala, jelikoz mam vstupni data dofinovana v Array rucne, misto aby si vstupni data procedura vytahla z list3, ale bohuzel zatim sem neprisel na to jak)
K temto vytvorenym datum v list2 potrebuji pak priradit hodnoty z list1, s tim ze nyni jiz v list1 nemam pouze konkretni dvojice dat ktere bych mohl porovnavat, ale obcas i mnoziny dat.
Tedy pokud jsou na list1 hodnoty:
allA Z 3
Hodnota 3 by se mi mela prenest k vsem nasledujicim dvojicim, tedy:
A Z 3
B Z 3
C Z 3
D Z 3
E Z 3
Z prilozeneho prikladu snad bude srozumitelnejsi nez mym psanym vykladem.
Procedury jsou v prilozenem .xls, ale dodavam pro prehlednost i do tela tematu:
Procedura generovani vsech kombinaci:
Kód: Vybrat vše
Sub Kombinace()
Dim abc As Variant
Dim xyz As Variant
Dim r As Integer
Dim x As Integer
Dim y As Integer
abc = Array("A", "B", "C", "D", "E")
xyz = Array("X", "Y", "Z")
r = 1
With Worksheets("List2")
.Cells(r, 1) = "abc"
.Cells(r, 2) = "xyz"
For x = 0 To UBound(abc)
For y = 0 To UBound(xyz)
r = r + 1
.Cells(r, 1) = abc(x)
.Cells(r, 2) = xyz(y)
Next y
Next x
End With
End Sub
Procedura vyhledavani a plneni dat:
Kód: Vybrat vše
Option Explicit
Sub VyhledatDoplnit()
Dim BlkA As Range, BlkB As Range
Dim CllA As Range, CllB As Range
Dim frstAddr As String
' definovani bloku bunek na listech
With Worksheets("list1")
Set BlkA = .Range(("a1:a") & .Cells(.Rows.Count, "a").End(xlUp).Row)
End With
With Worksheets("list2")
Set BlkB = .Range(("a1:a") & .Cells(.Rows.Count, "a").End(xlUp).Row)
End With
' prochazet BlkA
For Each CllA In BlkA.Cells
' prohledavat BlkB
With BlkB
Set CllB = .Find(CllA.Value, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows)
If Not CllB Is Nothing Then ' pri shode porovnat sloupce B:B
frstAddr = CllB.Address
Do
If CllB.Offset(0, 1).Value = CllA.Offset(0, 1).Value Then ' pri shode doplnit do sl C:C data
' abs nova hodnota > abs stara hodnota
If Abs(CllA.Offset(0, 2).Value) >= Abs(CllB.Offset(0, 2).Value) Then
If Abs(CllA.Offset(0, 2).Value) > Abs(CllB.Offset(0, 2).Value) Then
CllB.Offset(0, 2).Value = CllA.Offset(0, 2).Value
Else: CllB.Offset(0, 2).Value = "kolize"
End If
End If
End If
Set CllB = .FindNext(CllB)
Loop While CllB.Address <> frstAddr
End If
End With
Next CllA
' odstranit objektove promenne
Set CllB = Nothing
Set CllA = Nothing
Set BlkB = Nothing
Set BlkA = Nothing
End Sub
