Note: The other languages of the website are Google-translated. Back to English

Sut i redeg macro ar yr un pryd ar draws sawl ffeil llyfr gwaith?

Yr erthygl hon, byddaf yn siarad am sut i redeg macro ar draws ffeiliau llyfr gwaith lluosog ar yr un pryd heb eu hagor. Gall y dull canlynol eich helpu i ddatrys y dasg hon yn Excel.

Rhedeg macro ar yr un pryd ar draws nifer o lyfrau gwaith gyda chod VBA


Rhedeg macro ar yr un pryd ar draws nifer o lyfrau gwaith gyda chod VBA

I redeg macro ar draws nifer o lyfrau gwaith heb eu hagor, cymhwyswch y cod VBA canlynol:

1. Daliwch i lawr y ALT + F11 allweddi i agor y Microsoft Visual Basic ar gyfer Ceisiadau ffenestr.

2. Cliciwch Mewnosod > Modiwlau, a gludwch y macro canlynol yn y Modiwlau Ffenestr.

Cod VBA: Rhedeg yr un macro ar lyfrau gwaith lluosog ar yr un pryd:

Sub LoopThroughFiles()
    Dim xFd As FileDialog
    Dim xFdItem As Variant
    Dim xFileName As String
    Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
    If xFd.Show = -1 Then
        xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
        xFileName = Dir(xFdItem & "*.xls*")
        Do While xFileName <> ""
            With Workbooks.Open(xFdItem & xFileName)
                'your code here
            End With
            xFileName = Dir
        Loop
    End If
End Sub

Nodyn: Yn y cod uchod, copïwch a gludwch eich cod eich hun heb y is pennawd a Is-End troedyn rhwng y Gyda Workbooks.Open (xFdItem & xFileName) ac Diwedd Gyda sgriptiau. Gweler y screenshot:

doc yn rhedeg ffeiliau macro lluosog 1

3. Yna pwyswch F5 allwedd i weithredu'r cod hwn, ac a Pori ffenestr yn cael ei harddangos, dewiswch ffolder sy'n cynnwys y llyfrau gwaith rydych chi am i bob un ohonynt gymhwyso'r macro hwn, gweler y screenshot:

doc yn rhedeg ffeiliau macro lluosog 2

4. Ac yna cliciwch OK botwm, bydd y macro a ddymunir yn cael ei weithredu ar unwaith o un llyfr gwaith i eraill.

 


Yr Offer Cynhyrchedd Swyddfa Gorau

Mae Kutools for Excel yn Datrys y rhan fwyaf o'ch Problemau, ac yn Cynyddu Eich Cynhyrchedd 80%

  • Ailddefnyddio: Mewnosod yn gyflym fformwlâu cymhleth, siartiau ac unrhyw beth rydych chi wedi'i ddefnyddio o'r blaen; Amgryptio Celloedd gyda chyfrinair; Creu Rhestr Bostio ac anfon e-byst ...
  • Bar Fformiwla Gwych (golygu llinellau lluosog o destun a fformiwla yn hawdd); Cynllun Darllen (darllen a golygu nifer fawr o gelloedd yn hawdd); Gludo i'r Ystod Hidlo...
  • Uno Celloedd / Rhesi / Colofnau heb golli Data; Cynnwys Celloedd Hollt; Cyfuno Rhesi / Colofnau Dyblyg... Atal Celloedd Dyblyg; Cymharwch y Meysydd...
  • Dewiswch Dyblyg neu Unigryw Rhesi; Dewiswch Blank Rows (mae pob cell yn wag); Darganfyddiad Gwych a Darganfyddiad Niwlog mewn Llawer o Lyfrau Gwaith; Dewis ar Hap ...
  • Copi Union Celloedd Lluosog heb newid cyfeirnod fformiwla; Auto Creu Cyfeiriadau i Daflenni Lluosog; Mewnosod Bwledi, Blychau Gwirio a mwy ...
  • Testun Detholiad, Ychwanegu Testun, Tynnu yn ôl Swydd, Tynnwch y Gofod; Creu ac Argraffu Subtotals Paging; Trosi rhwng Cynnwys a Sylwadau Celloedd...
  • Hidlo Super (arbed a chymhwyso cynlluniau hidlo i ddalenni eraill); Trefnu Uwch yn ôl mis / wythnos / dydd, amlder a mwy; Hidlo Arbennig gan feiddgar, italig ...
  • Cyfuno Llyfrau Gwaith a Thaflenni Gwaith; Uno Tablau yn seiliedig ar golofnau allweddol; Rhannwch Ddata yn Daflenni Lluosog; Trosi Swp xls, xlsx a PDF...
  • Mwy na 300 o nodweddion pwerus. Yn cefnogi Swyddfa / Excel 2007-2019 a 365. Yn cefnogi pob iaith. Defnydd hawdd yn eich menter neu sefydliad. Nodweddion llawn treial am ddim 30 diwrnod. Gwarant arian yn ôl 60 diwrnod.
tab kte 201905

Mae Tab Office yn Dod â rhyngwyneb Tabbed i'r Swyddfa, a Gwneud Eich Gwaith yn Haws o lawer

  • Galluogi golygu a darllen tabbed yn Word, Excel, PowerPoint, Cyhoeddwr, Mynediad, Visio a Phrosiect.
  • Agor a chreu dogfennau lluosog mewn tabiau newydd o'r un ffenestr, yn hytrach nag mewn ffenestri newydd.
  • Yn cynyddu eich cynhyrchiant 50%, ac yn lleihau cannoedd o gliciau llygoden i chi bob dydd!
gwaelod officetab

 

sylwadau (35)
Wedi graddio 4.5 allan o 5 · Graddfeydd 1
Lleihawyd y sylw hwn gan y safonwr ar y wefan
Macro defnyddiol iawn, ac mae'n gweithio'n iawn, ond hoffwn allu dewis pa ffeiliau o'r ffolder honno yr wyf am i'r macro gael ei redeg ymlaen? Nid yw'r ffeiliau'n cael eu cynhyrchu'n awtomatig mewn ffolder ar wahân, ac mae angen i mi redeg macros gwahanol ar bob set o ffeiliau o'r ffolder honno, ac yna eu symud yn ôl yn y ffolder cychwynnol.
Lleihawyd y sylw hwn gan y safonwr ar y wefan
Dilynais gyfarwyddiadau ond cefais wall llunio "Loop wihtout Do". Beth ydw i ar goll? Mae fy nghod macro yn syml iawn dim ond newid maint ffont y rhesi penodedig. Yn gweithio ar ei ben ei hun. Dyma beth sydd gennyf... helpwch

Is-ddolen Trwy Ffeiliau()
Dim xFd Fel FfeilDialog
Dim xFdItem Fel Amrywiad
Dim xFileName Fel Llinyn
Gosod xFd = Application.FileDialog(msoFileDialogFolderPicker)
Os xFd.Show = -1 Yna
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xFileName = Dir(xFdItem & "*.xls*")
Gwnewch Tra bod xFileName <> ""
Gyda Workbooks.Open (xFdItem & xFileName)
'dy god yma
Rhesi ("2:8"). Dewiswch
Gyda Selection.Font
.Name = "Arial"
.Maint = 12
.Strikethrough = Gau
.Superscript = Gau
.Subscript = Gau
.OutlineFont = Gau
.Cysgod = Gau
.Underline = xlUnderlineStyleNone
.Color = -11518420
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
Diwedd Gyda
xFileName = Cyf
dolen
Gorffennwch Os
Is-End
Lleihawyd y sylw hwn gan y safonwr ar y wefan
Helo, yarto,
Fe wnaethoch chi fethu'r sgript "Diwedd gyda" ar ddiwedd eich cod, dyma'r un cywir:
Is-ddolen Trwy Ffeiliau()
Dim xFd Fel FfeilDialog
Dim xFdItem Fel Amrywiad
Dim xFileName Fel Llinyn
Gosod xFd = Application.FileDialog(msoFileDialogFolderPicker)
Os xFd.Show = -1 Yna
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xFileName = Dir(xFdItem & "*.xls*")
Gwnewch Tra bod xFileName <> ""
Gyda Workbooks.Open (xFdItem & xFileName)
'dy god yma
Rhesi ("2:8"). Dewiswch
Gyda Selection.Font
.Name = "Arial"
.Maint = 16
.Strikethrough = Gau
.Superscript = Gau
.Subscript = Gau
.OutlineFont = Gau
.Cysgod = Gau
.Underline = xlUnderlineStyleNone
.Color = -11518420
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
Diwedd Gyda
Diwedd Gyda
xFileName = Cyf
dolen
Gorffennwch Os
Is-End

Rhowch gynnig arni, gobeithio y gall eich helpu!
Lleihawyd y sylw hwn gan y safonwr ar y wefan
Macro defnyddiol iawn, ac mae'n gweithio'n wych, ond hoffwn allu dewis pa ffeiliau o'r ffolder honno yr wyf am i'r macro gael ei redeg ymlaen? Er enghraifft mae gen i 4 ffeil mewn ffolder gyda ffeiliau excel eraill a dim ond ar y 4 ffeil benodol hynny rydw i eisiau iddo redeg. Sut alla i newid eich macro i adael i mi ddewis y 4 ffeil hynny o'r ffolder honno?
Lleihawyd y sylw hwn gan y safonwr ar y wefan
Helo, Joel,
Er mwyn sbarduno'r un cod mewn llyfrau gwaith penodol, dylech gymhwyso'r cod isod:

Is-ddolen Trwy Ffeiliau()
Dim xFd Fel FfeilDialog
Dim xFdItem Fel Amrywiad
Dim xFileName Fel Llinyn
Dim xFB Fel Llinyn
Gyda Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = Gwir
.Hidlau.Clear
.Filters.Ychwanegu "excel", "*.xls*"
.sioe
If .SelectedItems.Count < 1 Yna Gadael Is
Ar gyfer lngCount = 1 I .SelectedItems.Count
xFileName = .SelectItems(lngCount)
Os yw xFileName <> " "Yna
Gyda Workbooks.Open(Filename:=xFileName)
' eich cod
Diwedd Gyda
Gorffennwch Os
Cyfrif lng Nesaf
Diwedd Gyda
Is-End

Rhowch gynnig arni, gobeithio y gall eich helpu!
Lleihawyd y sylw hwn gan y safonwr ar y wefan
diolch, roedd yn ddefnyddiol iawn
Lleihawyd y sylw hwn gan y safonwr ar y wefan
Hi!

Rwy'n ceisio mewnosod fy nghod yn eich un chi a phan fyddaf yn rhedeg y macro mae'n rhoi'r neges ganlynol i mi: Gwall amser rhedeg '429': Ni all ActiveX greu'r gwrthrych. Rhowch wybod sut y gellir ei drwsio. Diolch!

Fy nghod:

Gosod RInput = Ystod ("A2: A21")
Gosod ROutput = Ystod ("D2: D22")

Dim A() Fel Amrywiad
ReDim A(1 I RInput.Rows.Count, 0)
A = RInput.Value2

Gosod d = CreateObject("Scriptting.Dictionary")

Ar gyfer i = 1 I UBound(A)
Os oes d.(A(i, 1)) Yna
d(A(i, 1)) = d(A(i, 1)) + 1
arall
d.Add A(i, 1), 1
Gorffennwch Os
Digwyddiadau
Ar gyfer i = 1 I UBound(A)
A(i, 1) = d(A(i, 1))
Digwyddiadau

ROoutput = A
Lleihawyd y sylw hwn gan y safonwr ar y wefan
Helo, yn gyntaf diolch am y macro hwn, dyna'n union yr oeddwn yn edrych amdano. Fodd bynnag, mae gennyf un broblem, a oes ffordd i gau a chadw fel pob ffenestr wrth iddi gwblhau. Mae gen i nifer fawr o ffeiliau ac rydw i'n rhedeg allan o RAM cyn i'r gweithrediad gael ei gwblhau.
Lleihawyd y sylw hwn gan y safonwr ar y wefan
Ie, Ychwanegwch yr isod eich cod canlynol os ydych yn dymuno iddo gadw'r ffeil gyda'r un enw:

'Achub y Gweithlyfr
ActiveWorkbook.Save
Lleihawyd y sylw hwn gan y safonwr ar y wefan
Helo, Caitlin,
Efallai y gall y cod isod eich helpu chi, bob tro ar ôl rhedeg eich cod penodol, bydd blwch prydlon arbed ffeil yn ymddangos yn eich atgoffa i gadw'r llyfr gwaith.

Is-ddolen Trwy Ffeiliau()
Dim xFd Fel FfeilDialog
Dim xFdItem Fel Amrywiad
Dim xFileName Fel Llinyn
Dim xWB Fel Gweithlyfr
Gosod xFd = Application.FileDialog(msoFileDialogFolderPicker)
Os xFd.Show = -1 Yna
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xFileName = Dir(xFdItem & "*.xls*")
Ar Ail-ddechrau Gwall Nesaf
Gwnewch Tra bod xFileName <> ""
Gosod xWB = Llyfrau Gwaith.Open(xFdItem & xFileName)
Gyda xWB
'dy god yma
Diwedd Gyda
xWB.Cau
xFileName = Cyf
dolen
Gorffennwch Os
Is-End
Lleihawyd y sylw hwn gan y safonwr ar y wefan
Hi!

Rwy'n ceisio mewnosod fy nghod yn eich un chi a phan fyddaf yn rhedeg y macro mae'n rhoi'r neges ganlynol i mi: Gwall amser rhedeg '429': Ni all ActiveX greu'r gwrthrych. Rhowch wybod sut y gellir ei drwsio. Diolch!

Fy nghod:

Gosod RInput = Ystod ("A2: A21")
Gosod ROutput = Ystod ("D2: D22")

Dim A() Fel Amrywiad
ReDim A(1 I RInput.Rows.Count, 0)
A = RInput.Value2

Gosod d = CreateObject("Scriptting.Dictionary")

Ar gyfer i = 1 I UBound(A)
Os oes d.(A(i, 1)) Yna
d(A(i, 1)) = d(A(i, 1)) + 1
arall
d.Add A(i, 1), 1
Gorffennwch Os
Digwyddiadau
Ar gyfer i = 1 I UBound(A)
A(i, 1) = d(A(i, 1))
Digwyddiadau

ROoutput = A
Lleihawyd y sylw hwn gan y safonwr ar y wefan
Helo,

Rwyf wedi defnyddio'r macro hwn yn llwyddiannus i fformatio ffeiliau NBA ar gyfer y 30 tîm, pob un â'i lyfr ei hun. Ddoe, derbyniais neges gwall nd na all Modiwl (macro) gael ei gwblhau na'i ddileu na'i olygu (i'w gadw). Mae wedi llygru fy llyfr gwaith macro personol ac wedi gwneud Excel bron yn annefnyddiadwy i mi. Mae'n chwalu'r app bob tro rwy'n ceisio cyrchu macro o unrhyw ffeil. Nid yw cefnogaeth Excel a chefnogaeth Windows wedi gallu trwsio pethau. Gallwch chi helpu?
Lleihawyd y sylw hwn gan y safonwr ar y wefan
Helo, A oes ffordd y gallaf ddiffinio cyrchfan y ffeil yn y sgript ei hun. Rwyf am hepgor y broses 3 lle mae'n rhaid i ni bori'r ffolder penodol.
Lleihawyd y sylw hwn gan y safonwr ar y wefan
Helo, diolch am y cod hwn. a allwch ddweud wrthyf os gwelwch yn dda sut y gallaf gael canlyniad fy macro yr agorais yr holl lyfrau gwaith ar ei gyfer mewn un ddalen (canlyniad pob llyfr gwaith yn olynol)? ac a oes ffordd i ychwanegu enw pob llyfr gwaith at y rhes gyda'r data o'r cam blaenorol?
Lleihawyd y sylw hwn gan y safonwr ar y wefan
Hi

Cefais aa gwall amser rhedeg 1004: nid yw cystrawen yn gywir pan redais y cod canlynol sef y Extend Office VBA i "Rhedeg macro ar yr un peth ar draws llyfrau gwaith lluosog gyda chod VBA" gyda'r Extend Office VBA "Dileu pob ystod a enwir gyda chod VBA" yn y slot mewnosod eich cod:

Is-ddolen Trwy Ffeiliau()

Dim xFd Fel FfeilDialog

Dim xFdItem Fel Amrywiad

Dim xFileName Fel Llinyn

Gosod xFd = Application.FileDialog(msoFileDialogFolderPicker)

Os xFd.Show = -1 Yna

xFdItem = xFd.SelectedItems(1) & Application.PathSeparator

xFileName = Dir(xFdItem & "*.xls*")

Gwnewch Tra bod xFileName <> ""

Gyda Workbooks.Open (xFdItem & xFileName)

' Is-Dileu Enwau()

'Diweddariad 20140314

Dim xName Fel Enw

Ar gyfer Pob xName Mewn Cymhwysiad.ActiveWorkbook.Names

xName.Dileu

Digwyddiadau


Diwedd Gyda

xFileName = Cyf

dolen

Gorffennwch Os

Is-End

Yr hyn yr wyf yn ceisio ei wneud yw rhedeg macro sy'n dileu'r ystodau a enwir mewn wyth llyfr gwaith sydd wedi'u cynnwys yn yr un ffolder.

BTW, dyma'r tro cyntaf i mi ddefnyddio rhywbeth o Extend Office ac nid yw wedi gweithio. Mae'r wefan hon wedi bod o gymorth mawr i mi.

Byddai awgrymiadau/sylwadau'n cael eu gwerthfawrogi'n fawr.

aldc
Lleihawyd y sylw hwn gan y safonwr ar y wefan
Helo, adc,
Mae eich cod yn gweithio'n dda yn fy llyfr gwaith, pa fersiwn Excel ydych chi'n ei ddefnyddio?
Lleihawyd y sylw hwn gan y safonwr ar y wefan
Helo, mae'r cod hwn mor dda a defnyddiol. Rwy'n ei ddefnyddio llawer!

Y dyddiau hyn, yn fy sefydliad rydym bellach yn defnyddio SharePoint i storio ein ffeiliau. A oes unrhyw ffordd i wneud i'r cod hwn weithio ar draws pob ffeil mewn ffolder sharepoint?
Lleihawyd y sylw hwn gan y safonwr ar y wefan
Helo, diolch am y cod hwn.
A oes ffordd i ddolennu trwy is-ffolderi hefyd? Gadewch i ni ddweud bod gen i un ffolder ac o fewn y ffolder ddeg ffolder arall, pob un yn cynnwys ffeil excel.

A oes ffordd i ddewis y ffolder cynradd yn unig fel bod y cod yn rhedeg trwy ei holl is-ffolderi?

Diolch yn fawr.
Lleihawyd y sylw hwn gan y safonwr ar y wefan
Helo, Darko, I redeg cod o ffolder gyda'r is-ffolderi, cymhwyswch y cod canlynol: Sub LoopThroughFiles_Is-ffolderi(xStrPath As String)
Dim xSFolderName
Dim xFileName
Dim xArrSFPath() Fel Llinyn
Dim xI Fel Cyfanrif
Os xStrPath = " " Yna Gadael Is
xFileName = Dir(xStrPath & "*.xls*")
Gwnewch Tra bod xFileName <> ""
Gyda Workbooks.Open(xStrPath & xFileName)
'dy god yma
Diwedd Gyda
xFileName = Cyf
dolen
xSFolderName = Cyfeiriad(xStrPath, vbDirectory)
xI = 0
ReDim xArrSFPath(0)
Gwnewch Tra bod xSFolderName <> ""
Os yw xSFolderName <> "." A xSFolderName <> ".." Yna
Os (GetAttr(xStrPath & xSFolderName) A vbDirectory) = vbDirectory Yna
xI = xI + 1
ReDim Cadw xArrSFPath(xI)
xArrSFPath(xI - 1) = xStrPath & xSFolderName & "\"
Gorffennwch Os
Gorffennwch Os
xSFolderName = Cyf
dolen
Os UBound(xArrSFPath) > 0 Yna
Ar gyfer xI = 0 I UBound(xArrSFPath)
LoopThroughFiles_Is-ffolderi (xArrSFPath(xI))
Nesaf xI
Gorffennwch Os
Is-End
Is-ddolen Trwy Ffeiliau()
Dim xFd Fel FfeilDialog
Dim xFdItem Fel Amrywiad
Dim xFileName Fel Llinyn
Gosod xFd = Application.FileDialog(msoFileDialogFolderPicker)
Os xFd.Show = -1 Yna
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
LoopThroughFiles_Is-ffolderi (xFdItem)
Gorffennwch Os
Diwedd SubPlease Ceisiwch, gobeithio y gall eich helpu!
Lleihawyd y sylw hwn gan y safonwr ar y wefan
Yn ogystal â'r cod uchod, a yw'n bosibl agor ffeiliau excel mewn trefn gronolegol roeddwn i eisiau?
Lleihawyd y sylw hwn gan y safonwr ar y wefan
Helo, diolch yn fawr iawn am y macro y mae'n ddefnyddiol iawn gweithio gydag ef. Roeddwn i'n meddwl tybed a oes gennym ffordd i adnewyddu'r ffolder yn y macro onedrive drwodd . Os oes, rhowch wybod i mi beth alla i ei wneud yma i adnewyddu'r ffeiliau yn onedrive gan ddefnyddio sgript macro?
Lleihawyd y sylw hwn gan y safonwr ar y wefan
Helo, diolch yn fawr am y sgript hon, rwy'n gweithio'n iawn iawn i mi, ond mae gen i anghenion arbennig: A oes ffordd i newid y sgript i gymhwyso fy nghod gydag amodau enw ffeil AC mewn is-ffolderi?
Egluraf : Athro ydw i ac fe wnes i greu datrysiad Excel i arbed canlyniadau myfyrwyr a chaniatáu i athrawon ymgynghori â nhw.I wneud hynny, mae gen i ffeil fesul is-jet ysgol ac un ar gyfer y dosbarth cyfrifol, i gyd mewn ffolder fesul dosbarth.
Felly pan fyddaf yn dod o hyd i nam neu optimeiddio, mae'n rhaid i mi adrodd am y newidiadau ym mhob ffeil ym mhob is-ffolder.
Ond gan nad yw pob ffeil yr un peth (gwahanol drefniadaeth subjets), hoffwn ffordd o gymhwyso fy nghod par exemple i'r holl ffeiliau o'r enw "dosbarth mathemateg" yn yr holl is-ffolderi, neu i'r gwrthwyneb, i gymhwyso fy nghod i bob ffeil mewn is-ffolderi ac eithrio pob ffeil o'r enw "xyz".Diolch !Fabrice
Lleihawyd y sylw hwn gan y safonwr ar y wefan
Nid yw'ch cod a roddwyd yn gweithio gyda'r VBA canlynol, a allwch chi helpu Is-Bwndeli()

Dim vWS Fel Taflen Waith
Dim vA, vA2()
Dim vR Cyhyd, vSwm Cyhyd, vC Cyhyd
Dim vN Cyhyd, vN2 Cyhyd, vN3 Cyhyd

Gosod vWS = ActiveSheet
Gyda vWS
vR = .Celloedd(Rhesi.Cyfrif, 4).Diwedd(xlUp).Rhes
vSum = Cais.Sum(.Range("D2:D" & vR))
ReDim Preserve vA2(1 I vSum, 1 I 4)
vA = .Range("A2:D" & vR)
Am vN = 1 I vR - 1
Ar gyfer vN2 = 1 I vA(vN, 4)
vC = vC + 1
Ar gyfer vN3 = 1 I 4
vA2(vC, vN3) = vA(vN, vN3)
vN3 nesaf
vN2 nesaf
vN nesaf
Diwedd Gyda
vC = 1
Am vN = 1 I vSum - 2
vA2(vN, 4) = vC
Os yw vA2(vN + 1, 2) = vA2(vN, 2) Yna
vC = vC + 1
vA2(vN + 1, 4) = vC
arall
vA2(vN + 1, 4) = 1
vC = 1
Gorffennwch Os
vN nesaf
Application.ScreenUpdating = Anghywir
Taflenni.Add
Gyda ActiveSheet
vWS.Range("A1:D1").Copi .Range("A1:D1")
.Celloedd(2, 1).Newid maint(vSum, 4) = vA2
Diwedd Gyda
Application.ScreenUpdating = Gwir

Is-End
Lleihawyd y sylw hwn gan y safonwr ar y wefan
Rwyf am redeg y VBA hwn yn Daflenni lluosog mewn ffolder ar y tro, a allwch chi helpu Is-Bwndeli ()

Dim vWS Fel Taflen Waith
Dim vA, vA2()
Dim vR Cyhyd, vSwm Cyhyd, vC Cyhyd
Dim vN Cyhyd, vN2 Cyhyd, vN3 Cyhyd

Gosod vWS = ActiveSheet
Gyda vWS
vR = .Celloedd(Rhesi.Cyfrif, 4).Diwedd(xlUp).Rhes
vSum = Cais.Sum(.Range("D2:D" & vR))
ReDim Preserve vA2(1 I vSum, 1 I 4)
vA = .Range("A2:D" & vR)
Am vN = 1 I vR - 1
Ar gyfer vN2 = 1 I vA(vN, 4)
vC = vC + 1
Ar gyfer vN3 = 1 I 4
vA2(vC, vN3) = vA(vN, vN3)
vN3 nesaf
vN2 nesaf
vN nesaf
Diwedd Gyda
vC = 1
Am vN = 1 I vSum - 2
vA2(vN, 4) = vC
Os yw vA2(vN + 1, 2) = vA2(vN, 2) Yna
vC = vC + 1
vA2(vN + 1, 4) = vC
arall
vA2(vN + 1, 4) = 1
vC = 1
Gorffennwch Os
vN nesaf
Application.ScreenUpdating = Anghywir
Taflenni.Add
Gyda ActiveSheet
vWS.Range("A1:D1").Copi .Range("A1:D1")
.Celloedd(2, 1).Newid maint(vSum, 4) = vA2
Diwedd Gyda
Application.ScreenUpdating = Gwir

Is-End
Lleihawyd y sylw hwn gan y safonwr ar y wefan
Ceisiais redeg y cod ond mae'r gwall "424 : Object Required" yn ymddangos ar y llinell "With Workbooks.Open(xFdItem & xFileName)". Wrth edrych yn ddyfnach, mae'n ymddangos nad yw'r llyfrau gwaith Excels sydd wedi'u storio yn y ffolder o ddiddordeb yn arddangos / yn bodoli (Pan agorodd y ffenestr gyda'r arddangosfa cod, os ceisiaf agor y ffolder a pheidio â'i ddewis, mae'n wag). Sut felly?
Is-ddolen Trwy Ffeiliau()
Dim xFd Fel FfeilDialog
Dim xFdItem Fel Amrywiad
Dim xFileName Fel Llinyn
Gosod xFd = Application.FileDialog(msoFileDialogFolderPicker)
Os xFd.Show = -1 Yna
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xFileName = Dir(xFdItem & "*.xls*")
Gwnewch Tra bod xFileName <> ""
Gyda Workbooks.Open (xFdItem & xFileName)
Sheets.Add After:=Taflen Weithredol
Taflenni ("Taflen 2"). Dewiswch
Sheets("Sheet2").Name = "Meistr"
Taflenni ("Meistr"). Dewiswch
Taflenni("Meistr").Symud Cyn:=Taflenni(1)
Diwedd Gyda
xFileName = Cyf
dolen
Gorffennwch Os
Is-End


A allwch chi fy helpu i ddatrys y broblem hon os gwelwch yn dda?
Lleihawyd y sylw hwn gan y safonwr ar y wefan
Dyma fy hoff wefan gyda'r cyfarwyddiadau cliriaf absoliwt (yn fwy felly nag unrhyw fideo YouTube) a dwi'n dod yn ôl ato dro ar ôl tro. Diolch yn fawr iawn am y sesiynau tiwtorial hyn - rydych chi'n achubwr bywyd myfyriwr graddedig trist.
Lleihawyd y sylw hwn gan y safonwr ar y wefan
Is-ddolen Trwy Ffeiliau()
Dim xFd Fel FfeilDialog
Dim xFdItem Fel Amrywiad
Dim xFileName Fel Llinyn
Gosod xFd = Application.FileDialog(msoFileDialogFolderPicker)
Os xFd.Show = -1 Yna
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xFileName = Dir(xFdItem & "*.xls*")
Gwnewch Tra bod xFileName <> ""
Gyda Workbooks.Open (xFdItem & xFileName)
' ActiveCell.Offset(0, 1).Colofnau("A:A").EntireColumn.Dewis
Selection.Insert Shift:=xlToRight
ActiveCell.Dewiswch
Diwedd Gyda
xFileName = Cyf
dolen
Gorffennwch Os
Diwedd Is, helpwch os gwelwch yn dda. BTW, estyniad fy ffeiliau excel yw (.csv - "comma delimited") . ac mae gen i 500 o ffeiliau excel mewn ffolder gyda chyfartaledd pob rhes o tua 500000 o resi .. Helpwch os gwelwch yn dda . Fi jyst eisiau mewnosod colofn ym mhob llyfr gwaith
Lleihawyd y sylw hwn gan y safonwr ar y wefan
a gawsoch chi erioed ateb i'ch cwestiwn? Rwy'n ceisio gwneud yr un peth i dros 3700 o ffeiliau csv. Mae angen i mi ychwanegu 1 golofn (A).
Lleihawyd y sylw hwn gan y safonwr ar y wefan
Helo, anghenus a Carly,Ar gyfer datrys eich problem, i redeg y cod ar gyfer sawl ffeil CSV, does ond angen i chi newid yr estyniad ffeil .xls i .csv fel y dangosir y cod isod: Is-ddolen Trwy Ffeiliau()
Dim xFd Fel FfeilDialog
Dim xFdItem Fel Amrywiad
Dim xFileName Fel Llinyn
Gosod xFd = Application.FileDialog(msoFileDialogFolderPicker)
Os xFd.Show = -1 Yna
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xFileName = Dir(xFdItem & "*.csv*")
Gwnewch Tra bod xFileName <> ""
Gyda Workbooks.Open (xFdItem & xFileName)
ActiveCell.Offset(0, 1).Colofnau("A:A").Colofn Gyfan.Dewis
Selection.Insert Shift:=xlToRight
ActiveCell.Dewiswch
Diwedd Gyda
xFileName = Cyf
dolen
Gorffennwch Os
Diwedd SubPlease Ceisiwch, gobeithio y gall eich helpu!
Lleihawyd y sylw hwn gan y safonwr ar y wefan
Helo, a yw'n bosibl rhedeg y macro yn unig yn y dalennau o wahanol lyfrau gwaith gydag enw penodol? Diolch!!
Lleihawyd y sylw hwn gan y safonwr ar y wefan
Helo, Sara,
Mae'n ddrwg gennyf, nid oes ateb da i'r broblem a godwyd gennych.
Diolch yn fawr!
Nid oes unrhyw sylwadau wedi'u postio yma eto
Llwytho mwy o
Gadewch eich sylwadau
Postio fel Gwestai
×
Graddiwch y swydd hon:
0   Cymeriadau
Lleoliadau a Awgrymir