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. lisaa rivi ennen rivia
    vika2=...

    WorkSheets("Taul2").Range("A:M")=""
    muuta toi alue sopivaksi
    @Kunde
  2. eipahan onnaa ilman koodia...
    ensiviikolla kysellaan lisaa
  3. ensiviikolla palaan asiaan...
    piece of cake pari rivia koodia
  4. no problems...
    palaan ensiviikolla asiaan kun taas normaali enkkuversio kaytossa
  5. Ei oikein taivu taa Kiinan kieli naissa koneissa taalla Kiinassa...
    palaan ensiviikolla asiaan jos viela silloinn tarvetta
  6. hae, haejasiirra, etsi etsijasiirra yms... a pilkut puuttuu kun ei skandeja tassa internetkoneessa ja en muista ulkoa niita...
    kirjoittajana kunde
    ja kymmenia vastauksia vastaaviin kyssareihin loytyy...
  7. jos tulostuksessa haluat eri muotoilut eri sivulle niin koodaamalla ihan helposti
    esim. Workbook_BeforePrint(Cancel As Boolean) tapahtumaan...
  8. viestissäni lukee erikseen moduulien paikat
    taulukon moduuliin...
    ja moduuliin...
    eli alla oleva tavalliseen moduuliin, EI taulukon moduuliin ja taatusti pelittäää

    moduuliin...

    Sub Täytä()
    On Error Resume Next
    Application.ScreenUpdating = False
    Range("Sheet2!D20:D44 ") = ""
    Range("Sheet2!I20:I44 ") = ""
    Range("Sheet2!J20:J44 ") = ""
    Range("A18").Copy
    Sheets("Sheet2").Range("D20").PasteSpecial Paste:=xlPasteValues
    Range("C18").Copy
    Sheets("Sheet2").Range("I20").PasteSpecial Paste:=xlPasteValues
    Range("E18").Copy
    Sheets("Sheet2").Range("J20").PasteSpecial Paste:=xlPasteValues

    Sheets("Sheet2").Range("D20").AutoFill Destination:=Range("Sheet2!D20:D" & 19 + Range("B18")), Type:=xlFillDefault
    Sheets("Sheet2").Range("I20").AutoFill Destination:=Range("Sheet2!I20:I" & 19 + Range("B18")), Type:=xlFillDefault
    Sheets("Sheet2").Range("J20").AutoFill Destination:=Range("Sheet2!J20:J" & 19 + Range("B18")), Type:=xlFillDefault
    Application.ScreenUpdating = True
    End Sub
  9. vaihda taulukon nimi sopivaksi nyt "Sheet2"
    taulukon moduuliin...

    Private Sub Worksheet_Change(ByVal Target As Range)

    If Not Application.Intersect(Target, Range("B18")) Is Nothing Then
    Täytä
    End If
    End Sub

    moduuliin...

    Sub Täytä()
    On Error Resume Next
    Application.ScreenUpdating = False
    Range("Sheet2!D20:D44 ") = ""
    Range("Sheet2!I20:I44 ") = ""
    Range("Sheet2!J20:J44 ") = ""
    Range("A18").Copy
    Sheets("Sheet2").Range("D20").PasteSpecial Paste:=xlPasteValues
    Range("C18").Copy
    Sheets("Sheet2").Range("I20").PasteSpecial Paste:=xlPasteValues
    Range("E18").Copy
    Sheets("Sheet2").Range("J20").PasteSpecial Paste:=xlPasteValues

    Sheets("Sheet2").Range("D20").AutoFill Destination:=Range("Sheet2!D20:D" & 19 + Range("B18")), Type:=xlFillDefault
    Sheets("Sheet2").Range("I20").AutoFill Destination:=Range("Sheet2!I20:I" & 19 + Range("B18")), Type:=xlFillDefault
    Sheets("Sheet2").Range("J20").AutoFill Destination:=Range("Sheet2!J20:J" & 19 + Range("B18")), Type:=xlFillDefault
    Application.ScreenUpdating = True
    End Sub
  10. en nyt parempaa vaihtoehtoa keksinyt...

    oletuksena nyt, että A- sarakkeessa on tietoa ja siitä haetaan se vika rivi. Muuta koodissa sarake sopivaksi.
    Toimii siten, että kun taulukossa joku arvo muuttuu vika rivi tulee tokassa paneelissa ylimmäiseksi. Voi scrollata normaalisti ja tehdä juttuja ihan normaalisti, mutta solun arvon muutoksesta pomppaa vikalle riville.
    Tarvittaessa muuta vika muuttujan arvoa jos haluat enemmän rivejä näkyviin ennen summariviä...
    esim. 5 riviä
    ActiveWindow.Panes(1).ScrollColumn = Range("A" & Vika-5).Column
    ActiveWindow.Panes(1).ScrollRow = Range("A" & Vika-5).Row

    1. Valitse rivi 2
    2. Valitse valikosta WINDOW/FREEZE PANES
    3. Kopioi makro taulukon moduuliin...


    Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Vika As Double
    Vika = Range("A65536").End(xlUp).Row
    ActiveWindow.Panes(1).ScrollColumn = Range("A" & Vika).Column
    ActiveWindow.Panes(1).ScrollRow = Range("A" & Vika).Row
    End Sub

    Keep Excelling
    @Kunde
  11. en edes ajttelesi koko hommaa. Tosi työlästä ja virheiden mahdollisuus kasvaa.
  12. Kyllä lajittelu toimii varmasti missä tahansa taulukossa. Ei tietoja tartte mihinkään toiseen tiedostoon siirrellä. Tosin makronauhottimella ei nyt kunnon koodia saakaan aikaiseksi...
    Pikkutrreeniä ja kyllä se siitä ;-)

    Keep Excelling
    Kunde
  13. lähestymistapa ;-)
    HYVÄ!
  14. http://www.contextures.com/xlDataVal02.html
  15. A1=lähtöaika
    A2=tuloaika

    soluun kaava =IF(INT(A2-A1)>0;INT(A2-A1)+IF(A2-A1-INT(A2-A1)>0,25;1;IF(A2-A1-INT(A2-A1)>2/24;0,5;0));IF(A2-A1-INT(A2-A1)>10/24;1;IF(A2-A1-INT(A2-A1)>6/24;0,5;0)))

    =B2 OR NOT B2
    @Kunde
  16. vaan argumenttejen syötöstähän tässä on kyse....
    ei toi onnaa ilman VBA: n apua automaattisesti

    soluun kaava =Keskihajonta(A2:A8;2), missä A2:A8 on asteikko ja offset 2 asteikosta eli C -sarakkeessa vastausten määrät.

    moduuliin...

    Option Base 1
    Function Keskihajonta(Arvot As Range) As Double
    Dim i As Long
    Dim j As Long
    Dim solu As Range
    Dim Arr() As Variant

    On Error Resume Next
    Application.Volatile
    j = 1
    For Each solu In Arvot
    ' määrät C sarakkeessa(Offset(0, 2)) kun kaavana =Keskihajonta(A2:A8;2)

    For i = 1 To solu.Offset(0, 2)
    ReDim Preserve Arr(j)
    Arr(j) = solu
    j = j + 1
    Next i
    Next solu
    Keskihajonta = Application.WorksheetFunction.StDev(Arr)
    End Function
  17. klikkaa hiiren oikealla jonkun valikon tai työkalupalkin päällä ja valitse avautuvasta valikosta Customize (Mukauta ?), sitten vain valitset normaalisti muokattavan napin ja klikkaat sitä hiiren oikealla ja avautuvasta valikosta Asssign Macro (Liitä Makro ?) jne...
  18. lpmaketyökaluista tehdylle combolle ominaisuudeksi ListFillRange esim. A1:B100 (tuote ja sen kerroin) ja alla oleva ko. taulukon moduuliin...
    muuta solua mihin kertoimen haluat (nyt K1)

    Private Sub ComboBox1_Change()
    Range("K1") = ComboBox1.Column(1)
    End Sub
  19. poista kaikista lisäosista ruksit ja lisää nyt käytössä olevia yksitellen ja katso mikä aiheuttaa ton virheen. Asenna se lisäosa sitten uudelleen.
    Todennäköisesti 2007 jäi jotakin "paskaa", mikä aiheuttaa versio yhteensopimattomuuden.
  20. korvaa aikaisempi koodi tällä ja näyttää kaappien nimet 1. riviltä
    taulukon moduuliin...

    Private Sub Worksheet_Change(ByVal Target As Range)
    Dim tulos As String
    Dim a As Variant
    Dim Kaapit As String
    On Error Resume Next
    If Not Intersect(Target, Range("K1")) Is Nothing Then
    tulos = EtsiJaNäytä(Range("K1"), Range("A:I")).Address
    If tulos = "" Then
    MsgBox "ei löytynyt!"
    Else
    a = Split(tulos, ",")
    For i = 0 To UBound(a)
    Kaapit = Kaapit & Range(Mid(a(i), 2, 1) & 1) & vbNewLine
    Next
    MsgBox Kaapit
    End If
    End If
    End Sub
    21. 47 / 69
TietosuojaselosteKäyttöehdotEvästeasetuksetSäännöt