kunde

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

Aloituksia

7

Kommenttia

1377

  1. Kysymys kuului
    "Tarkoituksena saada taulukkoon esim soluun
    A171 satunnainen 3numeroinen (väliltä 000-999) luku."
    sina vastaat
    "Excel ei tulkitse tätä enää lukuna mutta käsitteellisesti se on vastaus kysymykseen."

    elika et vielakaan osannut antaa vastausta kysymykseen vaan vastaat, etta tulos tulee TEKSTINA vaikka kysyja halusi sen NUMEERISENA.
    Miksi sitten et vastaa kerralla siten, etta tulos on numeerinen???
    Tama on pointtini kommentissani.
  2. Terveisia Kiinasta ja Thaimaasta...
    toimiiko kaavasi seuraavasti
    "Tarkoituksena saada taulukkoon esim soluun
    A171 satunnainen 3numeroinen (väliltä 000-999) luku"
    Ei millaan pahalla, mutta kannattaisiko tarkistaa vastaus ennenkuin lahettaa sen. Kyllastyttaa lukea naita "ei toimivia" vastauksia
  3. A1 kaava =SOLU("rivi";A1) ja kopioit alaspäin- toimii ilman kikkailuja
  4. Excelissä kannattaa tehdä.
    Moduuliin koodi...
    Nyt kysyy arvoa ja kopioi päiväykset F1 alkaen, muuta itsellesi sopivaksi :-)

    Sub Suodata()
    Dim Target As Range
    Dim i As Integer
    Dim Suodatetut As Range
    Dim KopioAlue As Range
    On Error GoTo virhe
    Range("F:F") = ""
    With Columns("A:C")
    x = Application.InputBox("Anna luku", Type:=1)
    .AutoFilter Field:=1, Criteria1:="=" & x, Operator:=xlAnd

    For Each solu In ActiveSheet.AutoFilter.Range.Columns(3).SpecialCells(xlCellTypeVisible)
    i = i + 1
    Cells(i, 6) = solu.Value
    Next solu
    .AutoFilter
    End With
    Exit Sub
    virhe:
    Columns("A:C").AutoFilter
    End Sub
  5. Tartu rules...

    mutta asiaaan
    lisää nimi jutullahan toi onnistuu
  6. moduuliin ja liität makron nappiin

    Sub KopioiJaSiirrä()
    Dim vika As Integer
    Dim vika2 As Integer
    Dim kopio As Range
    Dim i As Integer
    On Error Resume Next
    Taul1.Activate
    Sheets("Taul2").Range("A1:B" & Sheets("Taul2").Range("A65536").End(xlUp).Row) = ""
    vika = Sheets("Taul1").Range("D65536").End(xlUp).Row
    For Each solu In Sheets("Taul1").Range("D1:D" & vika)
    If solu "" And IsNumeric(solu) Then
    Set kopio = solu.Offset(0, -2).Resize(1, 2)
    For i = 1 To solu.Value
    vika2 = Sheets("Taul2").Range("A1").End(xlDown).Row
    If vika2 = 0 Then
    vika2 = 1
    Else
    vika2 = vika2 + 1
    End If
    kopio.Copy Destination:=Sheets("Taul2").Range("A" & vika2)
    Next i
    End If
    Next
    End Sub
  7. kundepuu@hotmail.com
  8. koska eihän C1 ja A3 leikkaa toisiaan!
    Koska ei ole tietoa miten haet solun A sarakkeesta niin en voi neuvoa enempää
    tolla pääset eteenpäin muutat vain koodissa
    Cells(Range("A3").Row, 3) Range("A3").Row tarvittavaksi A sarakkeen solun rivinumeroksi

    moduuliin...
    Sub Leikkaus()
    Dim x As Range
    Sheets("Taul1").Activate
    Set x = Application.Intersect(Range("C:C"), Cells(Range("A3").Row, 3))
    If x Is Nothing Then
    MsgBox "Alueet eivät leikkaa"
    Else
    x.Select
    End If
    End Sub
  9. kadonneet sulla kopioinnin yhteydessä.Muutin koodin yhdelle riville.
    tämä pätkä pitää olla yhdellä rivillä

    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="http://www.google.fi/search?hl=fi&q=" & haku & "&btnG=Google-haku&meta=", TextToDisplay:=teksti



    Sub HyperlinkinLisäys()
    Dim vika As Integer
    Dim haku As String
    Dim teksti As String
    Dim a As Variant
    Dim i As Integer

    vika = Range("D65536").End(xlUp).Row
    For i = 1 To vika
    Range("E" & i).Select
    If Range("D" & i) "" Then
    a = Split(ActiveCell.Offset(0, -1), " ")

    haku = a(0) & "+" & a(1)
    teksti = ActiveCell.Offset(0, -1) & " Google kuvalinkki"
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="http://www.google.fi/search?hl=fi&q=" & haku & "&btnG=Google-haku&meta=", TextToDisplay:=teksti


    End If
    Next i
    End Sub
  10. koodi moduuliin... ja liität nappiin

    Sub HyperlinkinLisäys()
    Dim vika As Integer
    Dim haku As String
    Dim teksti As String
    Dim a As Variant
    Dim i As Integer

    vika = Range("D65536").End(xlUp).Row
    For i = 1 To vika
    Range("E" & i).Select
    If Range("D" & i) "" Then
    a = Split(ActiveCell.Offset(0, -1), " ")

    haku = a(0) & "+" & a(1)
    teksti = ActiveCell.Offset(0, -1) & " Google kuvalinkki"

    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
    "http://www.google.fi/search?hl=fi&q=" & haku & "&btnG=Google-haku&meta=", _
    TextToDisplay:=teksti
    End If
    Next i
    End Sub
  11. ei hän siinä tartte kuin referenssit Exceliin
    ja siirtää datan sinne.
    Tiedot voit viedä esim. toiseen tauluun ja sitten toiseen teet raportin.En ajanut koodia läpi,mutta luultavasti pitäisi toimia.musita referenssi exceliin....

    Private Sub Tulosta_Click()
    Dim xl As Excel.Application
    Dim Kohde As Workbook
    Dim objDB As Database
    Dim objRS As Recordset
    Dim SQL As String
    Dim luku As Integer
    Set xl = New Excel.Application
    Set Kohde = Workbooks.Open("C:\Lähettämö\Lähete.xls", False, False)
    Set objDB = CurrentDb()
    SQL = "SELECT Merkki,Ovityyppi,Kpl,ToimitettuKpl,OikeaLeveys,OikeaKorkeus,Huom From Tilaukset WHERE Lähetyslista=False AND LaskunNumero= " & CboLaskunnumero & " "
    Set objRS = objDB.OpenRecordset(SQL, dbOpenDynaset)

    Worksheets("Data").Activate
    Range("A2:G1000") = ""
    Range("A2").CopyFromRecordset objRS
    xl.DisplayAlerts = False
    Kohde.Close SaveChanges:=false
    'tähän tulostusalue ja tulostusjutut
    xl.DisplayAlerts = True
    Set xl = Nothing
    Set Kohde = Nothing
    End Sub
  12. toimii erilailla VBA ja Excel

    The Round() funktio Excelissä käyttää aritmeettistä pyöristystä, mikä pyöristää .5 ylöspäin kun taas VBA käyttää Bankerin pyöristystä, joka pyöristää ylös tai alas riipuen lähimmästä parillisesta luvusta.
    Siis tulokset
    3,5 excel 4 ja VBA 4
    4,5 Excel 5 ja VBA 4

    tolla voi testata
    Sub koe()
    Range("B1") = Round(Range("A1"), 0)
    Range("B2") = Application.WorksheetFunction.Round(Range("A1"), 0)
    End Sub
  13. vaan näin esim.
    luku=Application.WorksheetFunction.Ceiling(Range("A1"), 1)

    yksi mahdollinen voisi olla Round Application.WorksheetFunction.Round

    VBAssa Round ja Int voisi tulla kysymykseen
  14. Nauhoita makro, jossa avaat tiedostosi ja teet tarvittavat toimenpiteet sille ja liität sen Auto_Open tapahtumaan. Jos haluat, että se tekstitiedosto aukeaa Exceliin aina kun käynnistät Excelin liitä työkirjasi, missä makro on XlStart kansioon.

    laita moduuliin
    Sub Auto_Open()
    OmaMakro ' nauhoittamasi makron nimi
    En Sub
  15. Alt+F11 ja VBAeditorissa projekteista valitset halutun taulukon ja sen ominaisuuksissa laitat Visible kohtaa 2 eli xlSheetVeryHidden,sitten Tools/VBAProjec Properties/Projection välilehti ja siihen täppä kohtaan Lock project for viewing ja salasanaksi halamasi salasana. Tallenna työkirja.
    Siinäpä se ja uteliaimmat pysyy loitolla.
  16. toimii hienosti yhdelle solulle.
    Itse ajattelin koodissani kyllä toimintaa kaikille mahdollisille soluille taulukossa, mutta en keksi miten summata kun sama luku syötetään uudelleen
  17. nyt ollaan saman taulun sisällä...
  18. ei toimi mulla...
  19. jos tarkoitit tätä.
    jos solussa luku 3 ja samaan soluun kirjoitetaan uudelleen luku 5 niin summaa luvut ja tulos on 8.
    Todellakin vuoden vaikein kyssäri... en keksi miten saisi summattua luvun joka on sama kuin vanha arvo solussa järkevällä tavalla.
    Poistamalla kommentit koodista lisää kyllä saman arvon, mutta kysyy joka kerta jos solun arvo ei muutu "lisätäänkö?"- jos vastaus on kyllä niin lisää muuten ei
    palataan asiaan myöhemmin


    Public vika As String
    Public summa As Double

    Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim Vastaus As Integer
    On Error Resume Next
    If Range(vika) summa Then
    Range(vika) = Range(vika) + summa
    Else
    ' Vastaus = MsgBox("Lisätäänkö?", vbInformation + vbYesNo)
    ' If Vastaus = vbYes Then
    ' Range(vika) = Range(vika) + summa
    ' End If
    End If
    If Range(vika) = 0 Then Range(vika) = ""
    vika = Target.Address
    summa = Target
    End Sub
  20. officen eri ohjelmissa on templatet...
    21. 68 / 69
TietosuojaselosteKäyttöehdotEvästeasetuksetSäännöt