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!

bakerman

Lid
  • Aantal items

    79
  • Registratiedatum

  • Laatst bezocht

Over bakerman

  • Titel
    Nieuweling

Profiel Informatie

  • Geslacht
    Man
  • Land
    België

Recente bezoekers van dit profiel

De recente bezoekers block is uitgeschakeld en zal niet meer getoond worden aan gebruikers.

  1. bakerman

    waarden uit een bestand overnemen in een ander

    Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("b2")) Is Nothing Then With Sheets("blad2") .Range("A" & .Rows.Count).End(xlUp).Offset(1).Resize(, 2).Value = Range("a2").Resize(, 2).Value End With End If End Sub
  2. bakerman

    Verwijderen van PUNT en KOMMA

    =SUBSTITUEREN(RK[-2];".";"")-RK[-1] @ emiel Rechter Test.xlsm klikken.
  3. bakerman

    Versprongen doorverwijzing

    Staan je weken horizontaal. Formule in A2 en naar rechts doortrekken. =VERSCHUIVING([Map2]Blad1!$B$42;0;(KOLOM()-1)*3) Staan je weken vertikaal. Formule in B1 en naar beneden dooretrekken. =VERSCHUIVING([Map2]Blad1!$B$42;0;(RIJ()-1)*3)
  4. bakerman

    keuzelijst met waarden

    Een ideetje om makkelijk alle bladnamen in een kolom te krijgen. BladNamen_Formula.xlsm
  5. bakerman

    VBA om datums te sorteren volgens dag en maand

    Kleine aanpassing. Sub SortBirthdays() Application.ScreenUpdating = False Dim lRow As Long With Blad1 lRow = .Cells(.Rows.Count, 1).End(xlUp).Row .Range("Z2:Z" & lRow).FormulaR1C1 = "=TEXT(RC3,""MMDD"")" .Range("A2:Z" & lRow).Sort .Range("Z2"), xlAscending, , , , , , xlNo .Range("Z2:Z" & lRow).Clear End With Application.ScreenUpdating = True End Sub en dan is dit het resultaat.
  6. bakerman

    VBA om datums te sorteren volgens dag en maand

    Deze sorteert op maand en dag. Je kan de dag en maandkolom zonder probleem verwijderen. Sub SortBirthdays() Application.ScreenUpdating = False Dim lRow As Long With Blad1 lRow = .Cells(.Rows.Count, 1).End(xlUp).Row .Range("Z2:Z" & lRow).FormulaR1C1 = "=TEXT(RC3,""MMDD"")" .Range("A2:Z" & lRow).Sort .Range("Z2"), xlAscending, , , , , , xlYes .Range("Z2:Z" & lRow).Clear End With Application.ScreenUpdating = True End Sub
  7. bakerman

    VBA om datums te sorteren volgens dag en maand

    Had 'm om te testen op vandaag gezet en vergeten terug te zetten. Private Sub Workbook_Open() With Sheets(1) For i = 2 To .Range("a1").End(xlDown).Row If (Day(CDate(.Range("c" & i).Value)) - Day(Date) = 1) * (Month(CDate(.Range("c" & i).Value)) - Month(Date) = 0) Then msg = msg & .Range("b" & i).Value & vbLf & vbLf End If Next i End With If msg <> vbNullString Then MsgBox msg & vbLf & "is (zijn) morgen jarig.", vbInformation, "Verjaardagen." End Sub
  8. bakerman

    VBA om datums te sorteren volgens dag en maand

    I.p.v. 3X op OK te moeten drukken. Private Sub Workbook_Open() With Sheets(1) For i = 2 To .Range("a1").End(xlDown).Row If (Day(CDate(.Range("c" & i).Value)) - Day(Date) = 0) * (Month(CDate(.Range("c" & i).Value)) - Month(Date) = 0) Then msg = msg & .Range("b" & i).Value & vbLf & vbLf End If Next i End With If msg <> vbNullString Then MsgBox msg & vbLf & "is (zijn) morgen jarig.", vbInformation, "Verjaardagen." End Sub
  9. bakerman

    emailadressen uit meedere excel bestanden extraheren

    Deze heb ik je ook al eens eerder gegeven. Sub UpdateBestanden() Dim FilePath$, Row&, Column&, Address$ 'change constants & FilePath below to suit '*************************************** Const SheetName$ = "Personalia" Address = Cells(11, 2).Address FilePath = "D:\Test2\" '*************************************** With CreateObject("scripting.filesystemobject").getfolder(FilePath) For Each fl In .Files If Right(fl.Name, 5) = ".xlsx" Then Cells(Rows.Count, 1).End(xlUp).Offset(1) = fl.Name Filename = fl.Name Cells(Rows.Count, 1).End(xlUp).Offset(0, 1) = GetData(FilePath, Filename, SheetName, Address) Columns.AutoFit End If Next End With End Sub Private Function GetData(path, file, sheet, Address) Dim Data$ Data = "'" & path & "[" & file & "]" & sheet & "'!" & _ Range(Address).Range("A1").Address(, , xlR1C1) GetData = ExecuteExcel4Macro(Data) End Function
  10. Een andere oplossing. Sub tst() Dim dic As Object, sn, i As Long sn = Blad2.Cells(1).CurrentRegion.Value Set dic = CreateObject("scripting.dictionary") For i = 2 To UBound(sn) If Not dic.exists(sn(i, 1)) Then dic.Add sn(i, 1), sn(i, 2) Else: dic.Item(sn(i, 1)) = dic.Item(sn(i, 1)) + sn(i, 2) End If Next sn = Blad1.Cells(1).CurrentRegion.Resize(, 3).Value For i = 2 To UBound(sn) If dic.exists(sn(i, 2)) Then sn(i, 3) = dic.Item(sn(i, 2)) Else: sn(i, 3) = 0 End If Next Blad1.Cells(1).Resize(UBound(sn), 3) = sn End Sub
  11. bakerman

    naderen van deadline - voorwaarde

    Selecteer C2 en kies dan voor Voorwaardelijke Opmaak in het Lint. Kies Formule gebruiken om te kiezen welke cellen worden opgemaakt. Zet volgende formule in de witte balk. =$C$2 < $B$2 + 15 Kies dan je Opmaak en klik OK.
  12. Wijzig de Const wDir in de correcte map waar alle bestanden staan. Sub ConsolidateAll() Dim rsCon As Object, rsData As Object, sFileName As String Dim Prov As String, ExProp As String, resarr ', wDir As String Const wDir = "D:\Test2\" Prov = IIf(Val(Application.Version) < 12, "Microsoft.Jet.OLEDB.4.0", "Microsoft.ACE.OLEDB.12.0") ExProp = IIf(Val(Application.Version) < 12, "8.0", "12.0") Sheets(1).Cells(1).CurrentRegion.Offset(1).ClearContents sFileName = Dir(wDir & "*.xlsx") Do While sFileName <> "" If sFileName <> ThisWorkbook.Name Then Set rsCon = CreateObject("ADODB.Connection"): Set rsData = CreateObject("ADODB.Recordset") rsCon.Open "Provider=" & Prov & ";Data Source=" & wDir & sFileName & _ ";Extended Properties=""Excel " & ExProp & ";HDR=No"";" rsData.Open "SELECT * FROM [Personalia$B2:B14];", rsCon, 0, 1, 1 If Not rsData.EOF Then resarr = rsData.GetRows End If Sheets(1).Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(UBound(resarr, 1) + 1, UBound(resarr, 2) + 1) = resarr sFileName = Dir: rsData.Close: Set rsData = Nothing: rsCon.Close: Set rsCon = Nothing End If Loop End Sub janlazeure.xlsm
  13. Je databasebestand is leeg dus waar moeten de gegevens dan komen ?
  14. bakerman

    Macro aanmaken om te printen

    Absoluut niet, dit was enkel een kort en bondige verduidelijking van de stappen die je moet ondernemen.
  15. bakerman

    Macro aanmaken om te printen

    Selecteer de kolommen A tem L. In het lint ga je naar Pagina-indeling - Afdrukbereik. Selecteer Afdrukbereik bepalen en sla je bestand op.
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!

×

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.