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

1374

  • Uusimmat aloitukset
  • Suosituimmat aloitukset
  • Uusimmat kommentit
  1. 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
  2. Tartu rules...

    mutta asiaaan
    lisää nimi jutullahan toi onnistuu
  3. 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
  4. [email protected]
  5. 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
  6. 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
  7. 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
  8. 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
  9. 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
  10. 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
  11. 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
  12. 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.
  13. 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
  14. nyt ollaan saman taulun sisällä...
  15. ei toimi mulla...
  16. 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
  17. officen eri ohjelmissa on templatet...
  18. ActiveCell.Offset(0, 5).Range("A1").Select '5 solua oikealle
    ActiveCell.Offset(0, -5).Range("A1").Select '5 solua vasemmalle
    ActiveCell.Offset(5, 0).Range("A1").Select ' 5 solua alas
    ActiveCell.Offset(-5, 0).Range("A1").Select ' 5 solua ylös
  19. laita otsikot
    A1=ryhmä B1=nimi D1=ryhmä
    A4=ryhmä B4=ryhmä

    solusta A5 alkaen dataa

    soluun D2 kelpoisuusehto a,b,c
    soluun A2 kaava =D2

    taulukon moduuliin...

    Private Sub Worksheet_Calculate()
    Dim vika As Integer
    On Error GoTo virhe:
    Application.EnableEvents = False
    vika = Range("D65536").End(xlUp).Row
    Range("D4:E" & vika) = ""

    vika = Range("A65536").End(xlUp).Row

    Range("A4:B" & vika).AdvancedFilter Action:=xlFilterCopy, _
    CriteriaRange:=Range("A1:B2"), CopyToRange:=Range("D4"), Unique:=False

    virhe:
    Application.EnableEvents = True
    End Sub
  20. Excelissä tosiaan 256 saraketta, mutta officen Web komponenttien Spreadsheet komponentissä on sarakkeita ZZZ asti(18278-mahtuu about 50 vuotta...)
    Ei muuta kuin lisäät userformin ja sinne toi web objekti ja kalenteria väsäämään
    ;-)
    21. 68 / 69
TietosuojaselosteKäyttöehdotEvästeasetuksetSäännöt