|
Imam tabelo podatkov, kot je vidno na sliki. Tabela je velika skoraj 1000 vrstic in stolpcev in razdeljena na dva dela po diagonali. Vsaka celica iz enega dela tabele ima sorodno celico v drugem delu tabele, ki vsebuje enak podatek. Npr. celica v vrstici 1 stolpec 6 = celici v vrstici 6 stolpec 1 ali pa celica v vrstici 4 stolpec 3 = celici v vrstici 3 stolpec 4. V enem delu tabele imam obarvane podatke na podlagi enih kriterijev, v drugem delu tabele pa imam obarvane podatke na podlagi drugih kriterijev. Zdaj pa bi želel poiskati vse sorodne celice, ki so enako obarvane. Npr. celica v vrstici 1 in stolpcu 10 je obarvana zeleno. Njena sorodna celica je v vrstici 10 in stolpcu 1 in je prav tako obarvana zeleno. Takšne celice bi rad poiskal. Je to izvedljivo?
|
|
|
Klikni Alt+F11, zgoraj klikni Insert/Module, prilepi spodnjo kodo:
Sub Primerjaj()
Dim x, y
x = 7 ' tukaj napišeš, v kateri vrstici je prvi podatek
y = 4 ' tukaj napišeš, v katerem stolpcu je prvi podatek
x = x - 2
y = y - 2
For i = 1 To 10
For j = 1 + i To 10
If Cells(j + x, i + y).Interior.ColorIndex <> Cells(i + x, j + y).Interior.ColorIndex Then
Else
Cells(j + x, i + y).Font.Bold = 1
Cells(i + x, j + y).Font.Bold = 1
Cells(j + x, i + y).Borders.LineStyle = xlDouble
Cells(i + x, j + y).Borders.LineStyle = xlDouble
End If
Next
Next
End Sub
Če je tabela takšna kot na sliki, bo koda delovala, sicer moraš spremeniti parametra x in y.
spremenil: Matej V. (1.12.2011 ob 19.01.20)
|
|
|
Sem naredil po tvojih navodilih, sedaj pa ne vem naprej. Nisem se še nikoli do sedaj ukvarjal s moduli ali kaj to pač je
|
|
|
Joj, sem pozabil na koncu bistvo
Ko prilepiš, stisni zgoraj na zeleno puščico
spremenil: kljuka (30.11.2011 ob 15.35.32)
|
|
|
Sedaj izgleda takole
|
|
|
Aha ... Ti bi torej rad, da ti označi samo barvne kvadratke. Če sta oba bela, potem naj ti ga ne označi??
Sub Primerjaj()
Dim x, y
x = 7 ' tukaj napišeš, v kateri vrstici je prvi podatek
y = 4 ' tukaj napišeš, v katerem stolpcu je prvi podatek
x = x - 2
y = y - 2
For i = 1 To 10
For j = 1 + i To 10
If Cells(j + x, i + y).Interior.ColorIndex = Cells(i + x, j + y).Interior.ColorIndex And Cells(j + x, i + y).Interior.ColorIndex <> -4142 Then
Cells(j + x, i + y).Font.Bold = 1
Cells(i + x, j + y).Font.Bold = 1
Cells(j + x, i + y).Borders.LineStyle = xlDouble
Cells(i + x, j + y).Borders.LineStyle = xlDouble
Else
End If
Next
Next
End Sub
spremenil: kljuka (30.11.2011 ob 19.32.32)
|
|
|
Uf, tole pa ni ravno enostavno. Hvala kljuka za trud, samo jaz bi rad da mi označi samo sorodne celice, ki so v obeh tabelah isto obarvani (rdeče ali zeleno), kot sem napisal v prvem postu. Torej, če pogledam samo prvo vrstico in stolpec bi mi naj poiskalo celice
1-2; 2-1
1-10; 10-1
1-13; 13-1
|
|
|
Ta moja druga koda ne deluje?
|
|
Prikazujem 1 od skupno 1 strani |
|