• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Celwaarde op verschillende plaatsen, in verschillendebestanden, wijzigen.

Status
Niet open voor verdere reacties.
T

Thierry61

Gebruiker
Lid geworden
16 jan 2014
Berichten
28
Hallo,

ik heb 150 bestanden waarop op 3 verschillende plaatsen, nml: B13, F13 en J13 (op elk bestand dezelfde plaats) de waarde met 2,5 zou moeten vermenigvuldigd worden.
Hoe pak ik dit best en snelst aan?

Alvast bedankt.
 
je zou deze kunnen draaien:


Code: 
Sub AllWorkbooks()

     Dim wbk As Workbook

On Error Resume Next

Application.ScreenUpdating = False



With Application.FileDialog(msoFileDialogFolderPicker)

.Show

.AllowMultiSelect = False



MyFolder = .SelectedItems(1) & "\"

End With

MyFile = Dir(MyFolder)



Do While MyFile <> “”



   Set wbk = Workbooks.Open(Filename:=MyFolder & MyFile)



With Sheets(1)

    For i = 2 To 10 Step 4
    
        .Cells(13, i).Value = .Cells(13, i).Value * 2.5
    Next
End With

wbk.Close savechanges:=True

MyFile = Dir

Loop

Application.ScreenUpdating = True

End Sub
 
Staan de bestanden in dezelfde map? Zijn het de enige bestanden in deze map of hebben ze een bepaald kenmerk? Staan de gegevens die aangepast moeten worden altijd in Blad1 of is de bladnaam altijd hetzelfde? Je geeft werkelijk geen enkele informatie.

@SjonR, Is er een glas cola oid over je toetsenbord gevallen? <Enter> zit nogal vaste en <Tab> werkt blijkbaar ook niet lekker.:p:d
 
@VenA , De bestanden staan allemaal in de map "Run".
Het zijn de enige bestanden en wat moet aangepast worden staat altijd op het blad "Recept" op cel B13, F13 en J13.
 
Laatst bewerkt:
Werkt de code van @SjonR in #2 niet? Of heb je het nog niet getest? De basis staat erin. Een map 'Run' geeft totaal niet aan waar de bestanden staan.
 
Ga er een van de dagen mee aan de slag.
Alvast bedankt. Ik laat nog iets weten.
 
@SjonR

Ik heb je code gebruikt maar spijtig genoeg is het niet wat ik wou.
Je code geeft alleen de wijzigingen in het bestand waarin de code staat. In de andere geen wijzigingen en de "gewijzigde datum" (in verkenner) van de overige bestanden is nog steeds dezelfde als voordien.

Nog ff de nodige info:

150 bestanden (allemaal .xlsx)
Locatie = d:\test\run\
Sheet1 cel B13, F13 en J13 vermenigvuldigen met 2,5
 
Test dit maar eens.
Code: 
Sub hsv()
Dim bestandopen, wb As Worksheet, cl
Application.ScreenUpdating = False
 bestandopen = Dir("d:\test\run\*")
  Do Until bestandopen = ""
     Set wb = Workbooks.Open("[COLOR=#3E3E3E]d:\test\run\[/COLOR]" & bestandopen).Sheets(1)
      For Each cl In Array(wb.Range("b13"), wb.Range("f13"), wb.Range("j13"))
        cl.Value = cl.Value * 2.5
    Next cl
      Workbooks(bestandopen).Close True
    bestandopen = Dir
  Loop
End Sub
 
Laatst bewerkt:
@SjonR
Code werkt toch. Type fout van mij
Hartelijk dank

@HSV
Code getest en werkt
Hartelijk dank

Bijkomend vraagje:

Elk bestand heeft een Sheet2 dewelke dient om de revesies bij te houden. In kolom A het nr van de revisie, in kolom B wat er is gewijzigd en in kolom C de datum

vb:
bestand A.xlsx (sheet2) A3 = 3, B3 = pollen toegevoegd, C3 = 21/01/2015
bestand B.xlsx (sheet2) A1 = 1, B1 = inhoud gewijzigd, B1 = 14/08/2017
bestand C.xlsx (sheet2) A8 = 8, B8 = Naam gewijzigd, B1 = 10/08/2016

Kan ik met een code in de eerst volgende lege rij van elk bestand data laten invullen?

vb:
bestand A.xlsx (sheet2) A4 = 4, B4 = B13, F13 en J13 gewijzigd, C4 = (Datum van toevoeging)
bestand B.xlsx (sheet2) A2 = 2, B2 = B13, F13 en J13 gewijzigd, C4 = (Datum van toevoeging)
bestand C.xlsx (sheet2) A9 = 9, B9 = B13, F13 en J13 gewijzigd, C4 = (Datum van toevoeging)

Dus, op Sheet2 op de eerst volgend rij
 
Laatst bewerkt:
Dit bedoel je?
Code: 
Sub hsv()
Dim bestandopen, wb As Worksheet, cl
Application.ScreenUpdating = False
 bestandopen = Dir("d:\test\run\*")
  Do Until bestandopen = ""
     Set wb = Workbooks.Open("d:\test\run\" & bestandopen).Sheets(1)
      For Each cl In Array(wb.Range("b13"), wb.Range("f13"), wb.Range("j13"))
        cl.Value = cl.Value * 2.5

    Next cl
       [COLOR=#0000FF]wb.parent.sheets(2).cells(rows.count,1).end(xlup).offset(1).resize(,3) = array(wb.parent.sheets(2).cells(rows.count,1).end(xlup).value +1,"gewijzigd",date)[/COLOR]
      Workbooks(bestandopen).Close True
    bestandopen = Dir
  Loop
End Sub
 
Oké het werkt.
Doch als er in b13 en/of f13 en/of j13 iets anders staat dan een cijfer (vb: "-") dan werkt het niet.
Hoe kan ik dit oplossen?

mvg,
Thierry
 
Zorgen dat er geen streepje of tekst in die cellen komen.
Je kan geen streepje vermenigvuldigen met 2,5.

Of:
If isnumeric(cl) then cl.value= cl.value.*2.5
 
Laatst bewerkt:
Is er ook een mogelijkheid om in een lege (zelf bepalende) cel te vervangen met een verwijzing? vb: cel "i1" (is leeg) te vervangen met "=Revisies!D60".
Dit eveneens voor alle 150 bestanden.

mvg,
Thierry
 
Van welk blad?
 
De vorige vraag was ook goed bevonden?
Code: 
Sub hsv()
Dim bestandopen, wb As Worksheet, cl
Application.ScreenUpdating = False
 bestandopen = [COLOR=#3E3E3E]Dir("d:\test\run\*")[/COLOR]
  Do Until bestandopen = ""
     [COLOR=#3E3E3E]Set wb = Workbooks.Open("d:\test\run\" & bestandopen).Sheets(1)[/COLOR]
      For Each cl In Array(wb.Range("b13"), wb.Range("f13"), wb.Range("j13"))
        If IsNumeric(cl) Then cl.Value = cl.Value * 2.5
      Next cl
       wb.cells(1, 9) = "=Revisies!D60"
      [COLOR=#0000FF]wb.parent.sheets(2).cells(rows.count,1).end(xlup).offset(1).resize(,3) = array(wb.parent.sheets(2).cells(rows.count,1).end(xlup).value +1,"gewijzigd",date)[/COLOR]
      Workbooks(bestandopen).Close True
    bestandopen = Dir
  Loop
End Sub
 
Prachtig, alles werkt.
Bedankt!!!
Is het ook mogelijk om een vaste cel een bepaalde eigenschap te geven?
nml. "Sheet1", cel "i1", celeigenschap " "Datum :" dd/mm/jj "

mvg:
Thierry
 
Code: 
wb.cells(1, 9) = "=Revisies!D60"
wb.cells(1, 9).numberformat = "dd/mm/yy"
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan