Hinnavaatlus
:: Foorum
:: Uudised
:: Ärifoorumid
:: HV F1 ennustusvõistlus
:: Pangalink
:: Telekavad
:: HV toote otsing
|
|
autor |
|
grete1
HV vaatleja
liitunud: 15.01.2012
|
15.01.2012 21:14:20
Excel VBA |
|
|
Kas siin leidub kedagi, kes oskab Excelis makrosid teha ja on nõus sellel teemal veidi aitama?
Mul valmis töö olemas, kuid oleks vaja et keegi oskaks seletada, mida makros kirjutatu tähendab. Iseenesest töö on hästi lühike.
|
|
tagasi üles |
|
 |
alfreedo
HV vaatleja
liitunud: 20.06.2010
|
15.01.2012 21:48:37
|
|
|
Pane oma kood või fail siia üles ja kaeme perra.
|
|
Kommentaarid: 2 loe/lisa |
Kasutajad arvavad: |
   |
:: |
0 :: |
0 :: |
2 |
|
tagasi üles |
|
 |
grete1
HV vaatleja
liitunud: 15.01.2012
|
15.01.2012 21:52:43
|
|
|
Sub nimed()
Dim keskmine_t As Double
Dim keskmine_n As Double
Dim keskmine As Double
For Each c In ActiveSheet.Range("nimed: D24").Cells
keskmine_n = keskmine_n + 1
keskmine_t = keskmine_t + Len(c.Value)
keskmine = keskmine_t / keskmine_n
If Len(c.Value) > keskmine Then c.Font.Bold = True
Next
For Each c In ActiveSheet.Range("nimed: D24").Cells
keskmine_n = keskmine_n + 1
keskmine_t = keskmine_t + Len(c.Value)
keskmine = keskmine_t / keskmine_n
If Len(c.Value) < keskmine Then c.Font.Italic = True
Next
End Sub
Ma ei tea kas sellest on üldse võimalik nii aru saada, aga point on selles, et excelis on antud tabel nimedega ja makro peab tegema nii, et keskmisest pikemad nimed läheks bold kirja, keskmisest lühemad kaldkirja ja keskmise pikkusega jääks samaks. Ma tean, et mul on seal mingi viga sees, aga see pole oluline. Mul on lihtsalt vaja teada, mida iga rida teeb, milleks ta seal on. Et ma oskaks vastata kui mult küsitakse.
|
|
tagasi üles |
|
 |
andrusny
Kreisi kasutaja

liitunud: 20.03.2006
|
15.01.2012 22:08:47
|
|
|
Kohe esimene asi pane mõlemad if võrdused ühte tsüklisse, miks jooksutad sama asja kaks korda.
Ennem pead keskmise pikkuse ka ju leidma, teed tsükli mis liidab kõigi pikkused kokku ja lõpus jagab nimede arvuga. See oleks nagu esimene tsükkel ja sinna ei pane mingit If lauset, teise paned mõlemad ifid ja kui juba keskmine käes on.
For Each c In ActiveSheet.Range("nimed: D24").Cells
keskmine_n = keskmine_n + 1
keskmine_t = keskmine_t + Len(c.Value)
Next
keskmine = keskmine_t / keskmine_n
For Each c In ActiveSheet.Range("nimed: D24").Cells
If Len(c.Value) > keskmine Then c.Font.Bold = True
If Len(c.Value) < keskmine Then c.Font.Italic = True
Next |
_________________
 |
|
Kommentaarid: 7 loe/lisa |
Kasutajad arvavad: |
   |
:: |
0 :: |
0 :: |
7 |
|
tagasi üles |
|
 |
grete1
HV vaatleja
liitunud: 15.01.2012
|
15.01.2012 22:27:30
|
|
|
Suur aitäh abi eest
|
|
tagasi üles |
|
 |
alfreedo
HV vaatleja
liitunud: 20.06.2010
|
15.01.2012 23:38:20
|
|
|
Excelis on kasulik alati enne Sub lauset kasutada määrangut: Option Explicit
Siis annab kohe veateate: Variable not defined.
Dim c as range
Väheke teistmoodi siis aga pöhimõttelt sama
Sub Erinevus_keskmisest()
Dim keskmine As Long, kokku As Long, i As Long, a As Long
Dim c As Range
i = 1
kokku = 0
For Each c In Range("nimed: D24").Cells
a = Len(c)
kokku = kokku + a
i = i + 1
Next c
MsgBox "Kokku oli lahtreid" & vbCrLf & vbCrLf & i
keskmine = kokku / i
MsgBox "Keskmine sõna pikkus oli" & vbCrLf & vbCrLf & keskmine & " tähte"
For Each c In Range("nimed: D24").Cells
If Len(c) > keskmine Then c.Font.Bold = True
If Len(c) < keskmine Then c.Font.Italic = True
Next c
End Sub |
|
|
Kommentaarid: 2 loe/lisa |
Kasutajad arvavad: |
   |
:: |
0 :: |
0 :: |
2 |
|
tagasi üles |
|
 |
Danel332
HV vaatleja
liitunud: 27.10.2010
|
09.05.2013 22:04:15
|
|
|
Programmi algus on selline aga edasi oleks vaja kontrollida kas maatriks on sümmeetriline või mitte. Sellele enam enda hammas peale ei hakka.
Sub maatriksi()
Dim i, j, maatriks
ActiveSheet.UsedRange.Clear
maatriks = Val(InputBox("Sisesta maatriksi ridade ja veergude arv"))
For i = 1 To maatriks
For j = 1 To maatriks
Cells(i, j) = Int(Rnd() * 100)
Next j
Next i
If Cells(i, j) = Cells(j, i) Then
|
|
tagasi üles |
|
 |
mahfiaz
HV kasutaja
liitunud: 03.11.2005
|
09.05.2013 22:26:40
|
|
|
Danel332 kirjutas: |
Programmi algus on selline aga edasi oleks vaja kontrollida kas maatriks on sümmeetriline või mitte. Sellele enam enda hammas peale ei hakka.
Sub maatriksi()
Dim i, j, maatriks
ActiveSheet.UsedRange.Clear
maatriks = Val(InputBox("Sisesta maatriksi ridade ja veergude arv"))
For i = 1 To maatriks
For j = 1 To maatriks
Cells(i, j) = Int(Rnd() * 100)
Next j
Next i
If Cells(i, j) = Cells(j, i) Then |
Sa oled põhimõtteliselt õigel teel, midagi on loengust meelde jäänud. Nüüd tee uuesti samasugused kaks tsüklit, välimine läheb siis antud juhul ridade, sisemine veergude kaupa ning kontrolli, kas ikka on sümmeetria (mida see If lause ka teeb).
All on näide mõnevõrra keerukamast aga ka töötavast koodist, mis otsib "maatriks" nimelise lahtriga seotud alalt maatriksi ja kontrollib seda. Vastus kirjutatakse "symmeetriline" nimelisse lahtrisse. Seda otse kontrolltöösse ei ole mõtet kopeerida, õppejõud nagunii ei usuks.
Spoiler 
Sub leia_symmeetria()
Dim n As Integer
Dim mruut As Variant
Dim symmeetriline As Boolean
' Lähteandmed maatriksisse
mruut = Range("maatriks").CurrentRegion.Value
n = UBound(mruut, 1)
If n <> UBound(mruut, 2) Then
MsgBox ("Ala ei ole ruutmaatriks")
GoTo LeiaSymmeetriaLopp:
End If
symmeetriline = SymMatrix(mruut, n)
Range("symmeetriline") = symmeetriline
LeiaSymmeetriaLopp:
End Sub
Function SymMatrix(mruut, n)
Dim rida, veerg As Integer
SymMatrix = True
For rida = 2 To n
' Siin ei ole põhjust kontrollida tervet rida vaid piisab kui minna 1 kuni üks väiksem kui rida, muidu kontrollime sümmeetrilisust topelt.
' -1 kuna diagonaalil asuvat elementi pole mõtet kontrollida.
For veerg = 1 To rida - 1
If mruut(rida, veerg) <> mruut(veerg, rida) Then
SymMatrix = False
GoTo SymMatrixLopp
End If
Next veerg
Next rida
SymMatrixLopp:
End Function
|
|
|
Kommentaarid: 32 loe/lisa |
Kasutajad arvavad: |
   |
:: |
0 :: |
0 :: |
32 |
|
tagasi üles |
|
 |
Danel332
HV vaatleja
liitunud: 27.10.2010
|
14.05.2013 23:19:54
|
|
|
Just nende uute tsüklite tegemisemisest muutub asi minu jaoks arusaamatuks. Olen nii ja naa pidi neid proovinud aga tööle pole saanud neid.
|
|
tagasi üles |
|
 |
mahfiaz
HV kasutaja
liitunud: 03.11.2005
|
15.05.2013 01:04:04
|
|
|
Danel332 kirjutas: |
Just nende uute tsüklite tegemisemisest muutub asi minu jaoks arusaamatuks. Olen nii ja naa pidi neid proovinud aga tööle pole saanud neid. |
Võta proovi seda:
For i = 1 To 3
For j = 2 To 4
MsgBox "i on " & i & " ja j on " & j
Next j
Next i |
|
|
Kommentaarid: 32 loe/lisa |
Kasutajad arvavad: |
   |
:: |
0 :: |
0 :: |
32 |
|
tagasi üles |
|
 |
Danel332
HV vaatleja
liitunud: 27.10.2010
|
15.05.2013 08:21:55
|
|
|
Kas nii siis ?
Sub maatriksi()
Dim i, j, maatriks
ActiveSheet.UsedRange.Clear
maatriks = Val(InputBox("Sisesta maatriksi ridade ja veergude arv"))
For i = 1 To maatriks
For j = 1 To maatriks
Cells(i, j) = Int(Rnd() * 100)
Next j
Next i
If Cells(i, j) = Cells(j, i) Then
For i = 1 To 3
For j = 2 To 4
MsgBox "i on " & i & " ja j on " & j
Next j
Next i
For i = 1 To 3
For j = 2 To 4
MsgBox "i on " & i & " ja j on " & j
Next j
Next i
End If
End Sub
|
|
tagasi üles |
|
 |
mahfiaz
HV kasutaja
liitunud: 03.11.2005
|
15.05.2013 11:15:25
|
|
|
Danel332, ei, nii, ja ära unusta seda koodi siis käima panna:
Sub test()
For i = 1 To 3
For j = 2 To 4
MsgBox "i on " & i & " ja j on " & j
Next j
Next i
End Sub
|
Ja kui see sind ree peale ei aita, siis pead sa natukene endale natukene rohkem unetunde jätma või eraõpetaja palkama (või lausa mõlemat korrata).
|
|
Kommentaarid: 32 loe/lisa |
Kasutajad arvavad: |
   |
:: |
0 :: |
0 :: |
32 |
|
tagasi üles |
|
 |
Danel332
HV vaatleja
liitunud: 27.10.2010
|
15.05.2013 21:39:52
|
|
|
Ei aitand see mind ree peale. Ei ole veel sellist inimest (peale sinu) leidnud kes seda oskaks.
Ehk saaksid mu programmile kontrollimise alguse juurde teha siis vast edasi saaksin ise juba hakkama. Et saaks täpselt teada mis kuhu ja kuidas läheb. Saaks selle programmi kuidagi tehtud siis oleks aega juba edasi ise nuputada teistega.
|
|
tagasi üles |
|
 |
alfreedo
HV vaatleja
liitunud: 20.06.2010
|
16.05.2013 00:33:12
|
|
|
Danel322.
tsitaat: |
Olen nii ja naa pidi neid proovinud aga tööle pole saanud neid. |
tsitaat: |
Ei aitand see mind ree peale. |
On raske aidata, kui ei seletata oma probleemi lahti.
Kas kood ei tööta või ei ole tulemus see mis vajad vms?
Mida sa siin kontrollida tahad?
If Cells(i, j) = Cells(j, i) Then |
Cells(i, j) = Int(Rnd() * 100) |
Kuna kasutad Funktsiooni RND() siis lahtrite väärtuste vördlemine pole ehk mötekas tegu.
Pane oma koodi laused: Cells(i, j).select ja Cells(j, i).select ja sa näed, et "i" ja "j" antul juhul on lahtri aadressi veeru ja reanumbri indeksid.
Ka Google on hea abimees.
Leiab materjali ka eestikeelsena.
http://www.tud.ttu.ee/~vilip/VBA_raamat/VBA_HTML_P/Massiivid/Massiivid_P.html
|
|
Kommentaarid: 2 loe/lisa |
Kasutajad arvavad: |
   |
:: |
0 :: |
0 :: |
2 |
|
tagasi üles |
|
 |
Danel332
HV vaatleja
liitunud: 27.10.2010
|
16.05.2013 12:40:10
|
|
|
Ülesanne on selline: Genereeri ruutmaatriks ja kontrolli kas maatriks on sümmeetriline oma peadiagonaali suhtes.
Probleem on selles et ma ei oska seda kontrollimise osa kuidagi teha.
|
|
tagasi üles |
|
 |
pmq
HV kasutaja
liitunud: 29.01.2007
|
16.05.2013 13:13:06
|
|
|
mahfiaz esimeses postis on kenasti toimiv lahendus.
Siin see sinu koodile lisatuna. Näitab sammhaaval milliseid elemente võrreldakse (seni, kuni maatriks on sümmeetriline):
Sub maatriksi()
Dim i, j, maatriks
ActiveSheet.UsedRange.Clear
maatriks = Val(InputBox("Sisesta maatriksi ridade ja veergude arv"))
For i = 1 To maatriks
For j = 1 To maatriks
Cells(i, j) = Int(Rnd() * 100)
Next j
Next i
Dim rida, veerg
For rida = 2 To maatriks
ActiveSheet.UsedRange.Interior.Color = xlNone
For veerg = 1 To rida - 1
If Cells(rida, veerg) <> Cells(veerg, rida) Then
Cells(rida, veerg).Interior.Color = RGB(255, 0, 0)
Cells(veerg, rida).Interior.Color = RGB(255, 0, 0)
MsgBox "Maatriks ei ole sümmetriline!"
End
Else
Cells(rida, veerg).Interior.Color = RGB(0, 255, 0)
Cells(veerg, rida).Interior.Color = RGB(0, 255, 0)
MsgBox "ok" + vbCrLf + "veerg =" + Str(veerg) + ", rida =" + Str(rida)
End If
Next veerg
Next rida
End Sub
|
Lõpplahendus see ei ole, pead veel veidi nuputama.
|
|
Kommentaarid: 121 loe/lisa |
Kasutajad arvavad: |
   |
:: |
0 :: |
0 :: |
95 |
|
tagasi üles |
|
 |
mahfiaz
HV kasutaja
liitunud: 03.11.2005
|
16.05.2013 16:00:31
|
|
|
vwg, väga ilus näide
Tegin arvude genereerija natukene usinamaks, nüüd on ainult keskmiselt <10% lahtritest mittesümmeetrilised, samuti on numbrite vahemik väiksem. Vastasel juhul katkeb kontrollimine esimese lahtri juures.
Spoiler 
Sub maatriksi()
Dim i, j, maatriks
ActiveSheet.UsedRange.Clear
maatriks = Val(InputBox("Sisesta maatriksi ridade ja veergude arv"))
For i = 1 To maatriks
For j = 1 To maatriks
' Väike häkk, et rohkem sümmeetrilisust oleks,
' keskmiselt ainult 10% lahtreid on mitte-sümmeetrilised:
If Rnd() > 0.9 or i <= j Then
' Teeme mitte-sümmeetrilise või lisame uue väärtuse
Cells(i, j) = Int(Rnd() * 5)
Else
' Võtame sümmeetria kohast numbri
Cells(i, j) = Cells(j, i)
End If
Next j
Next i
Dim rida, veerg
For rida = 2 To maatriks
ActiveSheet.UsedRange.Interior.Color = xlNone
For veerg = 1 To rida - 1
If Cells(rida, veerg) <> Cells(veerg, rida) Then
Cells(rida, veerg).Interior.Color = RGB(255, 0, 0)
Cells(veerg, rida).Interior.Color = RGB(255, 0, 0)
MsgBox "Maatriks ei ole sümmetriline!"
End
Else
Cells(rida, veerg).Interior.Color = RGB(0, 255, 0)
Cells(veerg, rida).Interior.Color = RGB(0, 255, 0)
MsgBox "ok" + vbCrLf + "veerg =" + Str(veerg) + ", rida =" + Str(rida)
End If
Next veerg
Next rida
End Sub |
|
|
Kommentaarid: 32 loe/lisa |
Kasutajad arvavad: |
   |
:: |
0 :: |
0 :: |
32 |
|
tagasi üles |
|
 |
Danel332
HV vaatleja
liitunud: 27.10.2010
|
17.05.2013 23:24:26
|
|
|
Suured tänud aitajatele. Nüüd saab selle asjaga ühelepoole lõpuks.
|
|
tagasi üles |
|
 |
|