ruwe data wegschrijven

Status
Niet open voor verdere reacties.
J

jowey

Gebruiker
Lid geworden
18 mei 2017
Berichten
98
Hallo,

ik heb wat hulp nodig bij het wegschrijven van data.
De bedoeling is het bijgevoegd excel bestand als invulscherm te gebruiken voor data.
Deze moeten dan aan het eind van een dienst door een knop in te drukken weggeschreven worden naar ander tabblad/werkboek en invulvelden leeggemaakt worden.

Zoals het nu is kan ik dat wel in vba wegzetten. Echter dacht ik misschien ook aan iets van een userform, of iets in die richting om het wat gebruiksvriendelijker/overzichterlijker te maken.

Alvast bedankt.

Gr Jowey
 

Bijlagen

  • ruwe.data.xlsx
    25,9 KB · Weergaven: 46
Hallo,

ik ben er al uit.

Moet alleen nog 1 ding in de macro wegschrijven. Hoe pas ik de code aan opdat hij in Kolom I automatisch van kolom A + kolom E bij elkaar optelt?

Code: 
Sub SaveData()
Application.ScreenUpdating = False
Dim i As Long
Dim j As Long
Dim NumberOfLinesInvoer As Long
i = Sheets("Data").Range("A" & Rows.Count).End(xlUp).Row
NumberOfLinesInvoer = Sheets("Invoer").Range("B" & Rows.Count).End(xlUp).Row - 7

For j = 1 To NumberOfLinesInvoer
'kopieren data naar sheet data'
    Sheets("Data").Range("A" & (i + j)).Value = Sheets("Invoer").Range("c2").Value 'datum'
    Sheets("Data").Range("B" & (i + j)).Value = Sheets("Invoer").Range("c3").Value 'MO nummer'
    Sheets("Data").Range("C" & (i + j)).Value = Sheets("Invoer").Range("c4").Value 'start met'
    Sheets("Data").Range("D" & (i + j)).Value = Sheets("Invoer").Range("c5").Value 'team'
    Sheets("Data").Range("E" & (i + j)).Value = Sheets("Invoer").Range("B" & (7 + j)).Value  'tijd'
    Sheets("Data").Range("F" & (i + j)).Value = Sheets("Invoer").Range("C" & (7 + j)).Value 'aantal'
    Sheets("Data").Range("G" & (i + j)).Value = Sheets("Invoer").Range("D" & (7 + j)).Value 'afkeur'
    Sheets("Data").Range("H" & (i + j)).Value = Sheets("Invoer").Range("E" & (7 + j)).Value 'baseline'

  
    
Next j
     
    'leegmaken sheet
    Sheets("Invoer").Range("c2:c5").Select
    Selection.ClearContents
    Sheets("Invoer").Range("c8:c43").Select
    Selection.ClearContents
    Sheets("Invoer").Range("d8:d43").Select
    Selection.ClearContents
      
        
Application.ScreenUpdating = True
End Sub


Alvast bedankt.

Gr Jowey
 
Laatst bewerkt:
bestandje erbij :cool:
 

Bijlagen

  • test.xlsx
    38,3 KB · Weergaven: 39
Je kan het gewoon bij elkaar optellen.

Code: 
Sheets("Data").Range("I" & (i + j)).Value = Sheets("Invoer").Range("c2").Value + Sheets("Invoer").Range("B" & (7 + j)).Value 'datum + tijd

Je gebruikt ontzettend veel onnodige code maar wat werkt dat werkt.:)
 
Laatst bewerkt:
Ik ben ook maar een beginner met VBA. Ik snap het wel zo.
Maar als je zin hebt om het om te schrijven graag. Dan kan ik beide codes vergelijken en er wat van leren :d

Alvast dedankt voor de toevoeging

Gr,
 
Met een beetje meer tempo zal het zoiets worden.

Code: 
Sub VenA()
  ReDim ar1(35, 8)
  With Sheets("Invoer")
    ar = .Range("B2:E43")
    For j = 7 To UBound(ar)
      ar1(j - 7, 0) = ar(1, 2)
      ar1(j - 7, 1) = ar(2, 2)
      ar1(j - 7, 2) = ar(3, 2)
      ar1(j - 7, 3) = ar(4, 2)
      For jj = 1 To UBound(ar, 2)
        ar1(j - 7, jj + 3) = ar(j, jj)
      Next jj
      ar1(j - 7, 8) = ar(1, 2) + ar(j, 1)
    Next j
    Sheets("Data").Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(36, 9) = ar1
    .Range("C2:C5, C8:D43").ClearContents
  End With
End Sub
 
Ik ben nog op zoek naar 1 kleine aanpassing voor het bestand.
Ik heb een cel C5 met een keus toegevoegd en aan de hand van de keuze moet hij een andere deel wegschrijven. Ochtenddienst B9:F27 en bij avonddienst B28:F44
ik heb de optie if then geprobeerd maar loop vast.
Iemand een idee?

VenA, ik heb het geprobeerd maar jouw code kan ik (nog) niet lezen/begrijpen.

Alvast bedankt.

Gr Jowey
 

Bijlagen

  • test.if.then.xlsm
    47,1 KB · Weergaven: 20
Met wat aanpassingen ('structuring precedes coding') in het invoerblad kan het veel simpeler:

En vervolgens: de ochtenddienst loopt van 6:46 tot ..?.., en de avonddienst van ... tot ...?
 

Bijlagen

  • _shift_snb.xlsb
    36,2 KB · Weergaven: 20
Laatst bewerkt:
Hey snb,

ik kan niet helemaal volgen wat je bedoelt. Kan je iets meer uitleg geven?
Het bestandje werkt nu zoals hij is, echter wil ik per dienst data kunnen wegschrijven. Ik dacht dat dat met een simpele toevoeging in de code mogelijk was.

Ochtenddienst is van 06:45 t/m 14:45 en avonddienst van 14:45 t/m 23:15

Alvast bedankt.

Gr Jowey
 
Hey snb,

ik snap inmiddels wat je bedoelde en heb het daarmee ook kunnen oplossen.
Dank je voor de tip.

gr Jowey
 

Bijlagen

  • test.if.then.xlsm
    45,9 KB · Weergaven: 29
Kijk eerst eens naar de macro in de macromodule van het werkblad (= de macro achter de knop)..
Meer dan 2 regels code heb je niet nodig.
 

Bijlagen

  • _shift_snb.xlsb
    37,2 KB · Weergaven: 25
Laatst bewerkt:
Hey snb,

bedankt voor je berichtje.
Ik snap nog niet heel veel van wat er in staat, en ik krijg op sheet.data ook veel #N/A. Maar daar kom ik wel uit.

Gr Jowey
 
Iets vereenvoudigd
 

Bijlagen

  • _shift_snb.xlsb
    35,9 KB · Weergaven: 29
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan