kunde

kunde profiilikuva
Joulu 2024
Vapaa kuvaus

Isaan Rules WFF CCC If you walked away smiling-then for you the price was right Keep Exceling Suosikkibändit/artistit: Queen, Rammstein, genesis, Bruce Bringsteen, Kino, Mandref Mann Earth band Who Lempikirjat: ohjelmointi... Suosikkipalstat Suomi24 Keskusteluissa: EXCEL, Kivitalot, EPS En pidä: pakkanen ja loskakelit Ruoka & juoma: loimulohi ja valkkari Linkit: http://www.kundepuu.com, Khorat Koulutus: --- Ammatti: Tiede/teknologia Työskentelen: freelancer Ase tai siviilipalvelus: yliluutnantti Siviilisääty: Varattu Lapset: --- Hakusanat: Thaimaa, korat, Excel, VBA, ACAD, CNC, Polyurea, EPS, MgO elementti

Liittynyt 20v sitten
7 aloitusta · 1377 kommenttia
Uusimmat aloituksetSuosituimmat aloituksetUusimmat kommentit
kopioida kaava ja tyhjentää solun sisältö ja liittää taas siihen kaava - varsinkin jos tyhjennettävää on paljon. Kerkii siinä kahvit hörppiä kun makroa tehtäviään suorittaa ;-)

aina kannattaa käyttää excelin omia komentoja, jos suinkin voi ne toimii nopeimmin (yleensä) aina.

tuo luku 23 tulee siitä, että ynnätään yhteen allaolevat arvot seuraavasti

virhearvo =16
looginen arvo=4
numeroarvo=1
tekstiarvo=2

eli jos haluat tyhjentää vain virheet niin luvuksi 16

Sub Tyhjennä()
Range("A1:F10000").SpecialCells(xlCellTypeConstants, 23).ClearContents
End Sub

mutta alkuperäiseen kysymykseen vastaten, ei ole mahdollista tyhjentää solua säilyttämällä siinä olevaa kaavaa!!!
Äkkiseltään ei tule mieleen kuin kaavarivilllä maalaamalla funktiot.
Eli jos solussa A1 on kaava =B1+C1+D1 (voi olla ihan mikä tahansa kaava)
1. Maalaa B1 ja sitten paina F9 ja sitten
2. Maalaa C1 ja paina F9 ja lopuksi
3. Maalaa D1 ja paina F9.
Kaavarivillä näet nyt kaavasi tuloksen jokaisen solun erillisenä tuloksena. Ihan sama mikä funktio on kunhan maalat oikein...
4. Maalaa kaavarivi ja kopioi se
5. Liitä haluamaasi soluun(laita hipsu tai tyhjä välilyönti alkuun)
ja se on siinä...

@Kunde
Keep Excelling
pikkusen kuukkelia ja löytyy muutama miljoona sivua asiasta ;) ja sivuja myös mistä ladata vanha menu...
solumuotoilulla saat pari lisää, mutta koodilla sitten reippaasti lisää...

taulukon moduuliin...
ja nyt sarake C, muuta sopivaksi ja 7 ekaa kanssa

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim vika As Integer
vika = Range("C65536").End(xlUp).Row
For Each solu In Range("C1:C" & vika)
Select Case Left(solu, 7)
Case 1111111
solu.Interior.ColorIndex = 3
Case 1111112
solu.Interior.ColorIndex = 4
Case 1111113
solu.Interior.ColorIndex = 5
Case 1111114
solu.Interior.ColorIndex = 7
Case Else
solu.Interior.ColorIndex = xlNone
End Select
Next

End Sub

tavalliseen moduuliin...

tolla saat selville colorindexin numeroita vastaavat värit...

Sub Värit()
On Error Resume Next
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim i As Long
For i = 0 To 56
Cells(i + 1, 1).Interior.ColorIndex = i
Cells(i + 1, 1).Value = "[Väri " & i & "]"
Cells(i + 1, 2).Font.ColorIndex = i
Cells(i + 1, 2).Value = "Väri " & i
Next i
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

Keep Excelling
@Kunde
jos oikein tekee eli ...

Sub Koe1()
With Cells
.Font.Size = 12
.Font.Italic = True
End With
End Sub

mutta makronauhottimella tehdessä olet siirtänyt kohdistuksen alkuperäisestä solusta pois, joten vaatii palautuksen esim. noin

Sub Koe2()
Dim Vanha As String
Vanha = ActiveCell.Address
'koodia...
Range(Vanha).Select
End Sub
tuolla asiasta...

http://keskustelu.suomi24.fi/show.fcgi?category=108&conference=4500000000000708&posting=22000000023694023#22000000023694023

http://keskustelu.suomi24.fi/show.fcgi?category=108&conference=4500000000000708&posting=22000000006441562#22000000006441562

http://keskustelu.suomi24.fi/show.fcgi?category=108&conference=4500000000000708&posting=22000000023942139#22000000023942139
en tiedä OO mitään enkä haluakaan, mutta Excelillä se onnistuu...
noin 3 vuotta sitten vastasin vastaavaan

http://keskustelu.suomi24.fi/show.fcgi?category=108&conference=4500000000000708&posting=22000000009814213#22000000009814213

@Kunde
muuta itsellesi sopivaksi. Avaa ekan taulukon nyt.

normaali moduuliin...

Private Sub Auto_Open()
Sheets(1).Activate
ActiveSheet.ScrollArea = "A1:Z50"
End Sub

ThisWorkbook moduuliin...

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
ActiveSheet.ScrollArea = "A1:Z50"
End Sub
mutta voit tehdä ton piirtovalikon objekteilla ja liittää siihen kuvan ja kirjoittaa siihen tekstiä ihan normaalisti tai linkittää tekstin muualta
Lajittele sarakkeet ekaksi H ja sitten K sarakkeen mukaan ja sulla on 3 suurinta/pienintä arvoa 3 ylimmillä rivillä...
kopioitavan taulukon moduuliin...
kopioi nyt TAul2, muuta sopivaksi

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Cells.Copy Destination:=Sheets("Taul2").Range("A1")

End Sub
taulukon moduuliin...
oletuksena otsikot ekalla rivillä
muokkaa sopivaksi järjestys ja useammat sarakkeet, nyt lajittelee tuplaklikkauksella mistä tahansa solusta ko. solun sarakkeen mukaan...

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim vika As Long
vika= Cells(Rows.Count, 1).End(xlUp).Offset(0, 0).Row
Rows("2:" & vika).Sort Key1:=Cells(2, ActiveCell.Column), _
Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End Sub

Keep Excelling
@Kunde
VBA:lla ihan piece of cake, mutta normaalikaavoilla aika paha...

ei toimi ennenkuin 5 ei 0-arvoa on alueella. Muuta aluetta tarvittaessa, tietenkin alueen vosi vielä muuttaa dynaamiseksi,mutta jääköön se sun tehtäväksi, koska sen jo osaatkin

siis haluamaasi soluun kaava
=SUM(OFFSET($A$1;LARGE(IF(ISNUMBER($A$1:$A$100);IF($A$1:$A$1000;ROW($A$1:$A$100)));5)-1;0;100;))

ja muista, että kaava on matriisikaava,joten kaavarivillä ENTERin sijasta CTRL+SHIFT+ENTER

Keep Exceling
@Kunde
ilmeisesti kyse on viivakoodin tarkisteen laskemisesta
solussa A1 laskettu summa
tarkistenumero 2 saadaan kaavalla = MOD(A1,103)
suomiversiossa MOD taitaa olla JAKOJ
normaali array-lajittelulla onnistuu
nimet A-sarakkeessa ja aakkostaa B-sarakkeeseen

Sub Aakkosta()
Dim rarray As Variant
Dim Vika As Double
Dim lkm As Long
Dim lkm2 As Long
Dim Nimi1 As String
Dim Nimi2 As String

On Error Resume Next

Application.ScreenUpdating = False
Range("B:B")= ""

Vika = Range("A65536").End(xlUp).Row
rarray = WorksheetFunction.Transpose(Range("A1:A" & Vika).Value)

For lkm = 1 To UBound(rarray)
For lkm2 = lkm To UBound(rarray)
If UCase(rarray(lkm2)) < UCase(rarray(lkm)) Then
Nimi1 = rarray(lkm)
Nimi2 = rarray(lkm2)
rarray(lkm) = Nimi2
rarray(lkm2) = Nimi1
End If
Next lkm2
Next lkm

Range("B1:B" & UBound(rarray)) _
= WorksheetFunction.Transpose(rarray)
Application.ScreenUpdating = True
End Sub
sarakkeeseen solumuotoiluksi
0;0;"-";@ tai jos desimaaleja haluat esim. 2
0,00;0,00;"-";@

ja sitten vain lajittelu...
Mitenkas kuvat lisatty taulukkoon?
Onko kuvat aina saman nimisessa taulukossa?
Onko tyokirjan tauluko(i)ssa muita kuvia?
yms...
kun tarvittavat tiedot, niin toi on ihan piece of cake :-)
jos voit lahettaa mulle mallitaulukon, niin teen sulle makron
[email protected]
oikein vaan tayttaa koko sarakkeen ja ...

moduuliin...

Sub TaytaTyhjat()
Dim vika As Long
On Error Resume Next
vika = Range("A65536").End(xlUp).Row
Range("A1:A" & vika).SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
End Sub
Excelin omilla funktioilla

ThisWorkbook moduuliin...

Private Sub Workbook_BeforePrint(Cancel As Boolean)
Dim vika As Integer
vika = Range("O65536").End(xlUp).Row
ActiveSheet.PageSetup.PrintArea = "$A$1:$O$" & vika
End Sub
nyt ei näy ruudukkoa...

Sub ExcelistäWordiin()

Dim oWord As Word.Application
Dim oDoc As Word.Document
Dim ws As Worksheet

On Error Resume Next

Set oWord = GetObject(, "Word.Application")
If Err Then
Set oWord = New Word.Application
End If

On Error GoTo virhe
oWord.DisplayAlerts = wdAlertsNone
oWord.Visible = True
oWord.Activate
Set oDoc = oWord.Documents.Add
For Each ws In ActiveWorkbook.Worksheets
If ws.Name = "Sheet8" Or ws.Name = "Sheet9" Then
ws.UsedRange.Copy
oDoc.Paragraphs(oDoc.Paragraphs.Count).Range.InsertParagraphAfter
oDoc.Paragraphs(oDoc.Paragraphs.Count).Range.PasteExcelTable _
LinkedToExcel:=False, _
WordFormatting:=False, _
RTF:=True


Application.CutCopyMode = False
oDoc.Paragraphs(oDoc.Paragraphs.Count).Range.InsertParagraphAfter

If Not ws.Name = Worksheets(Worksheets.Count).Name Then
With oDoc.Paragraphs(oDoc.Paragraphs.Count).Range
.InsertParagraphBefore
.Collapse Direction:=wdCollapseEnd
.InsertBreak Type:=wdPageBreak
End With
End If
End If
Next ws
For Each aTable In oWord.ActiveDocument.Tables
aTable.ConvertToText wdSeparateByTabs, True
Next aTable
oDoc.Saved = True
oWord.DisplayAlerts = wdAlertsAll
Set oWord = Nothing
Set oDoc = Nothing
Exit Sub

virhe:
oWord.DisplayAlerts = wdAlertsAll
oWord.Quit
End Sub
59 / 69
TietosuojaselosteKäyttöehdotEvästeasetuksetSäännöt