Ga naar inhoud

Welkom op PC Helpforum!
PC Helpforum helpt GRATIS computergebruikers sinds 2006. Ons team geeft via het forum professioneel antwoord op uw vragen en probeert uw pc problemen zo snel mogelijk op te lossen. Word lid vandaag, plaats je vraag online en het PC Helpforum-team helpt u graag verder!


Log in om dit te volgen  
Gef

Sommen en lay-out maken met VBA

    Aanbevolen berichten

    Uit een softwarepakket kan ik een lijst exporteren naar Excel die er ongeveer zo uitziet:

     

    Titel

    Ondertitel

     

    Reeks I

         100100 artikel A          10,00

         100200 artikel B        112,00

         100300 artikel C            6,10

     

    Reeks II

          200100 artikel D          34,45

          200200 artikel E          10,20

          200250 artikel F         134,15

          200300 artikel G          75,00

     

     

    Het voorgaande staat allemaal in 1 kolom. enkel de bedragen staan in een tweede kolom

     

    Nu zou ik een code willen schrijven in VBA die het volgende doet:

    - automatisch een som maken per reeks

    - automatisch een som maken per ondertitel of titel

    - overtollige witte regels wissen

     

    Kunnen jullie mij helpen aub.  Ben vertrouwd met VBA maar op deze oefening zit ik al dagen (weken) mijn hoofd te breken om het efficient te laten lopen.   Let wel. Dit kan een lijst zijn met ettelijke honderden lijnen.   De code mag ook niet té traag lopen.

    Alvast bedankt!

    Deel dit bericht


    Link naar bericht
    Delen op andere sites

  • Topicstarter
  •    0

    Het wissen van overtollige witte regels is me gelukt.  Hoef hier dus geen antwoord meer op.

    Dus enkel nog:

    - automatisch een som maken per reeks

    - automatisch een som maken per ondertitel of titel

     

     

    thx

    Deel dit bericht


    Link naar bericht
    Delen op andere sites

    Een startbestandje in excel zou toch wat werk uitgespaard hebben.

    Hte is natuurlijk gissen wat titel en subtitel is.
    Beginnen deze steeds met een bepaald woord of letter?

     

    In bijlage vind je alvast een aanzet.

    Deel dit bericht


    Link naar bericht
    Delen op andere sites

    Log in om dit te volgen  

    • Welkom op PC Helpforum

    • Leden statistieken

      • Aantal leden
        38.989
      • Meeste online
        1.622

      Nieuwste lid
      Bloodnose
      Registratiedatum
    • Gerelateerde inhoud

      • Door bickyvp
        hallo iedereen,
         
        ik ben bezig voor mijn wergever met een excel van al onze stockproducten en om zo eenvoudig te kunnen zien wat er besteld moet worden.
        dit heb ik reeds gedaan.
         
        nu wil ik dat ik snel kan sorteren op wat er besteld moet worden.  het vak waarin staat dat er besteld moet worden is dmv vba.
        de celgrote is niet overal gelijk omdat dat niet anders kan of niet goed uitkomt.
         
        natuurlijk moet heel de rij juist mee volgen met het sorteren. ik krijg mijn werkbladen maar niet gesorteerd.
        waarbij ik meteen kan zien wat er moet besteld worden.
         
        kan iemand mij hierbij helpen of op weg zetten ?
        (ps: in bijlage vind je de excel, enkel de 3 eerste werkbladen wil ik zo gesorteerd hebben)
         
        alvast heel erg bedankt
        groeten michael
        magazijn vp.xlsm
      • Door t&d
        De code werkte eerst maar nu niet meer?
        Ik denk dat het tussen regel 6 en 19 zit maar ben niet zeker.

        Foutopsporing leid naar commandobutton, maar code is enkel om formulier te open
        Private Sub cmdopen_2_Click() Userform1.Show End Sub  
        Option Explicit Dim blnNew As Boolean Dim Dic As Object, i As Long Private Sub UserForm_Initialize() cmdSave.Enabled = False Frame2.Enabled = False Dim sv, i As Long sv = Sheets(1).Cells(1).CurrentRegion Set Dic = CreateObject("scripting.dictionary") For i = 1 To UBound(sv) If Not Dic.exists(sv(i, 1)) Then Dic.Item(sv(i, 1)) = Array(sv(i, 1), CreateObject("scripting.dictionary"), CreateObject("scripting.dictionary")) Dic(sv(i, 1))(1).Item(sv(i, 2)) = Dic(sv(i, 1))(1).Item(sv(i, 2)) Dic(sv(i, 1))(2).Item(sv(i, 2)) = Array(sv(i, 2), Application.Index(sv, i, Array(1, 3, 6, 7, 10, 11)), i) Next i ComboBox2.List = Dic.keys Dim wb As Workbook: Set wb = ThisWorkbook Dim WS As Worksheet Dim LastRow As Long Dim aCell As Range Set WS = wb.Sheets("Type data") With WS LastRow = .Cells(.Rows.Count, "C").End(xlUp).Row For Each aCell In .Range("C1:C" & LastRow) If aCell.Value <> "" Then Me.TextBox2.AddItem aCell.Value End If Next End With Set WS = wb.Sheets("Type data") With WS LastRow = .Cells(.Rows.Count, "O").End(xlUp).Row For Each aCell In .Range("O1:O" & LastRow) If aCell.Value <> "" Then Me.TextBox5.AddItem aCell.Value End If Next End With End Sub Private Sub cmdClose_Click() If cmdClose.Caption = "Close" Then Unload Me Else cmdClose.Caption = "Close" cmdNew.Enabled = True End If End Sub Private Sub cmdNew_Click() blnNew = True txtklant.Text = "" txttype.Text = "" txtdossier.Text = "" txtdatum.Text = "" txtbestand.Text = "" txtbestemming.Text = "" cmdClose.Caption = "Cancel" cmdNew.Enabled = False cmdSave.Enabled = True Frame2.Enabled = True End Sub Private Sub cmdSave_Click() If Trim(txtklant.Text) = "" Then MsgBox "Enter klant", vbCritical, "Save" txtklant.SetFocus Exit Sub End If Call prSave cmdClose.Caption = "Close" cmdNew.Enabled = True ThisWorkbook.Save End Sub Private Sub prSave() ''''' Save the dms If blnNew = True Then TRows = Worksheets("dms").Range("A1").CurrentRegion.Rows.Count With Worksheets("dms").Range("A1") .Offset(TRows, 0).Value = txtklant.Text .Offset(TRows, 1).Value = txttype.Text .Offset(TRows, 2).Value = txtdossier.Text .Offset(TRows, 3).Value = txtdatum.Text .Offset(TRows, 4).Value = txtbestand.Text .Offset(TRows, 11).Value = txtbestemming.Text End With txtklant.Text = "" txttype.Text = "" txtdossier.Text = "" txtdatum.Text = "" txtbestand.Text = "" txtbestemming.Text = "" Call prComboBoxFill Else For i = 2 To TRows If Trim(Worksheets("dms").Cells(i, 1).Value) = Trim(ComboBox3.Text) Then Worksheets("dms").Cells(i, 1).Value = txtklant.Text Worksheets("dms").Cells(i, 2).Value = txttype.Text Worksheets("dms").Cells(i, 3).Value = txtdossier.Text Worksheets("dms").Cells(i, 4).Value = txtdatum.Text Worksheets("dms").Cells(i, 5).Value = txtbestand.Text Worksheets("dms").Cells(i, 13).Value = txtbestemming.Text txtklant.Text = "" txttype.Text = "" txtdossier.Text = "" txtdatum.Text = "" txtbestand.Text = "" txtbestemming.Text = "" Exit For End If Next i End If blnNew = False If Trim(txtklant.Text) = "" Then cmdSave.Enabled = False Frame2.Enabled = False Else cmdSave.Enabled = True Frame2.Enabled = True End If End Sub Private Sub cmdSearch_Click() Userform1.Show End Sub Private Sub ComboBox2_Change() hsv ComboBox3.List = Dic(ComboBox2.Value)(1).keys ComboBox3.ListIndex = -1 End Sub Private Sub ComboBox3_Change() If ComboBox3.ListIndex > -1 Then For i = 1 To 6 Controls("Textbox" & i).Value = Dic(ComboBox2.Value)(2)(ComboBox3.Value)(1)(i) Next i End If End Sub Private Sub hsv() ComboBox3.ListIndex = -1 For i = 1 To 6 Me.Controls("TextBox" & i).Value = "" Next i End Sub Private Sub Image1_BeforeDragOver(ByVal Cancel As MSForms.ReturnBoolean, ByVal Data As MSForms.DataObject, ByVal X As Single, ByVal Y As Single, ByVal DragState As MSForms.fmDragState, ByVal Effect As MSForms.ReturnEffect, ByVal Shift As Integer) End Sub Private Sub Image2_BeforeDragOver(ByVal Cancel As MSForms.ReturnBoolean, ByVal Data As MSForms.DataObject, ByVal X As Single, ByVal Y As Single, ByVal DragState As MSForms.fmDragState, ByVal Effect As MSForms.ReturnEffect, ByVal Shift As Integer) End Sub  
        test_DMS.xlsm
      • Door Thomas Pertry
        Hallo
         
        Hoe kan je in word een woord automatisch laten herhalen, zoals de = fucntie in excell.  Als je bronveld dan veranderd, dan veranderd ook het gekopieerd veld.
         
        Bijvoorbeeld: ik maak een standaardbrief voor mijn klanten waar ik enkel de inhoud verander, maar kop en voettekst hetzelfde blijft.
        Bovenaan vermeld ik onze referenatie bvb TEPE/103/2019/234
         
        Ik wil de brief afsluiten met volgende zin: Gelieve bij al uw communicatie uw referentie TEPE/103/2019/234 te vermelden.  Uiteraard is onderaan de referentie gelijk aan die van bovenaan.  Maar hoe ik word deze altijd standaard laten kopiëren.  En als ik dus voor mijn volgende klant een nieuwe referentie maak bovenaan bvb TEPE/103/2019/235, dan moet hij dit onderaan automatisch veranderen.  
         
        Functie kan natuurlijk ook gebruikt worden voor de familienaam die bovenaan in de hoofding staat bij adresgegevens en deze dan te kopiëren naar de aanspreektitel.
         
        mvg
        thomas 
      • Door K5
        Hier ben ik terug!
        Mijn vorige vraag was om een Macro aan te maken om te printen.
        Ik heb dat excel bestand dus willen overmaken aan die dame, maar ondertussen heeft zij er nog enkele kolommen bij aangemaakt.
        Daarop heb ik haar uitgelegd dat er een knop was voorzien om enkel de kolom met de namen van de leden en de kolom met hun geboortemaand uit te printen.
        Waarop zij fijntjes vroeg of het ook mogelijk was om bij het sorteren via de geboortemaand, iedereen te sorteren volgens "geboortemaand" maar dan ook volgens "geboortedag".
        Het geboortejaar speelt niet direct een rol.
        Zij stuurt namelijk naar alle leden op hun verjaardag een berichtje of een kaartje. Zo kan zij dit beter opvolgen.
      • Door jord
        Beste alle,
        Ik wil graag jullie hulp inschakelen, om onderstaand vba beter te maken. D e bedoeling is dat gegevens van de factuur op een volgend blad geboekt worden. De vba werkt maar niet naar wens. Misschien dat jullie tips hebben.
         
        Sub Knop35_Klikken()
                Dim Datum, factnr, Relatie As String
                Dim totaal As Double
                Datum = Range("O19").Value
                factnr = Range("O20").Value
                Relatie = Range("O21").Value
             
             If Relatie = "" Then
                    MsgBox "Er is geen relatie geselecteerd."
                    Exit Sub
                End If
                If Datum = "" Then
                    MsgBox "Er is geen datum ingevuld."
                    Exit Sub
                End If
                If factnr = "" Then
                    MsgBox "Er is geen factuurnumer ingevuld."
                    Exit Sub
                End If
                With Worksheets("Verkoop").Range("C7:C10000")
                     Set factnr = .Find(Range("O20").Value, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
                     If Not factnr Is Nothing Then
                        MsgBox "Er is al een factuur met dit nummer aanwezig!"
                        Exit Sub
                      End If
                
        If IsEmpty(Sheets("verkoopfactuur").Range("O20")) Then
        MsgBox "factuurnummer niet ingevuld", vbCritical, "Factuurnummer"
        Exit Sub
        End If
            Dim ws1 As Worksheet, ws2 As Worksheet
            Set ws1 = Sheets("Verkoopfactuur")
            Set ws2 = Sheets("Verkoop")
            DestRow = ws2.Cells(Rows.Count, "A").End(xlUp).Row + 1
            
            ws1.Range("O34:R34").Copy
            ws2.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
            ws1.Range("T34").Copy
            ws2.Cells(Rows.Count, 1).End(xlUp).Offset(0, 5).PasteSpecial xlPasteValues
            
            ws1.Range("V34").Copy
            ws2.Cells(Rows.Count, 1).End(xlUp).Offset(0, 7).PasteSpecial xlPasteValues
            
            ws1.Range("X34").Copy
            ws2.Cells(Rows.Count, 1).End(xlUp).Offset(0, 9).PasteSpecial xlPasteValues
            
            ws1.Range("AA34:AC34").Copy
            ws2.Cells(Rows.Count, 1).End(xlUp).Offset(0, 12).PasteSpecial xlPasteValues
        End With
        End Sub
         
        Gr. Jord
    Logo

    OVER ONS

    PC Helpforum helpt GRATIS computergebruikers sinds juli 2006. Ons team geeft via het forum professioneel antwoord op uw vragen en probeert uw pc problemen zo snel mogelijk op te lossen. Word lid vandaag, plaats je vraag online en het PC Helpforum-team helpt u graag verder!

    ×
    ×
    • Nieuwe aanmaken...

    Belangrijke informatie

    We hebben cookies geplaatst op je toestel om deze website voor jou beter te kunnen maken. Je kunt de cookie instellingen aanpassen, anders gaan we er van uit dat het goed is om verder te gaan.