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

Ինչպե՞ս գործարկել մակրո միաժամանակ մի քանի աշխատանքային գրքերի ֆայլերի միջով:

Այս հոդվածում ես կխոսեմ այն ​​մասին, թե ինչպես մակրո վարել միաժամանակ մի քանի աշխատանքային գրքերի ֆայլերի վրա, առանց դրանք բացելու: Հետևյալ մեթոդը կարող է օգնել ձեզ լուծել այս խնդիրը Excel- ում:

Գործարկել մակրո միևնույն ժամանակ VBA կոդով մի քանի աշխատանքային գրքերում


Գործարկել մակրո միևնույն ժամանակ VBA կոդով մի քանի աշխատանքային գրքերում

Բազմաթիվ աշխատանքային գրքերում մակրո գործարկելու համար ՝ առանց դրանք բացելու, կիրառեք հետևյալ VBA կոդը.

1, Պահեք պահեք ALT + F11 բացել ստեղները Microsoft Visual Basic հավելվածների համար պատուհան.

2: Սեղմեք Տեղադրել > Մոդուլներ, և տեղադրեք հետևյալ մակրոը ՝ Մոդուլներ Պատուհանը:

VBA կոդ. Միևնույն ժամանակ աշխատեք միևնույն մակրոն մի քանի աշխատանքային գրքերի վրա.

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

ՆշումՎերոհիշյալ ծածկագրում խնդրում ենք պատճենեք և տեղադրեք ձեր սեփական ծածկագիրը առանց Sub վերնագիր եւ Վերջ Sub ստորոտը միջեւ Աշխատանքային տետրերով: Բաց (xFdItem & xFileName) և Վերջ սցենարներ Տեսեք,

փաստաթուղթ գործարկել մակրո բազմաթիվ ֆայլեր 1

3, Դրանից հետո սեղմեք F5 այս կոդը կատարելու բանալին և ա Թերթել ցուցադրվում է պատուհանը, ընտրեք այն թղթապանակը, որը պարունակում է աշխատանքային գրքեր, որոնք ցանկանում եք բոլորը կիրառել այս մակրոը, տե՛ս նկարը.

փաստաթուղթ գործարկել մակրո բազմաթիվ ֆայլեր 2

4. Եվ հետո կտտացրեք OK կոճակը, ցանկալի մակրոն կկատարվի միանգամից մեկ աշխատանքային գրքից մյուսը:

 


Գրասենյակի արտադրողականության լավագույն գործիքները

Excel-ի համար Kutools-ը լուծում է ձեր խնդիրների մեծ մասը և բարձրացնում ձեր արտադրողականությունը 80%-ով

  • Վերաօգտագործել: Արագ տեղադրեք բարդ բանաձևեր, գծապատկերներ և այն ամենը, ինչ դուք նախկինում օգտագործել եք. Ryածկագրել բջիջները գաղտնաբառով; Ստեղծեք փոստային ցուցակ և նամակներ ուղարկել ...
  • Super Formula Bar (հեշտությամբ խմբագրեք տեքստի և բանաձևի բազմաթիվ տողեր); Ընթերցանության դասավորությունը (հեշտությամբ կարդալ և խմբագրել մեծ թվով բջիջներ); Տեղադրել ֆիլտրացված տիրույթում...
  • Միաձուլել բջիջները / տողերը / սյունակները առանց տվյալների կորստի. Պառակտված բջիջների պարունակությունը; Միավորել կրկնօրինակ տողերը / սյունակները... Կանխել կրկնօրինակ բջիջները; Համեմատեք միջակայքերը...
  • Ընտրեք Կրկնօրինակ կամ Եզակի Շարքեր; Ընտրեք դատարկ շարքեր (բոլոր բջիջները դատարկ են); Super Find և Fuzzy Find շատ աշխատանքային գրքույկներում; Պատահական ընտրություն ...
  • Actշգրիտ պատճեն Բազմաթիվ բջիջներ ՝ առանց բանաձևի հղումը փոխելու; Ավտոմատ ստեղծեք հղումներ դեպի մի քանի թերթեր; Տեղադրեք փամփուշտներ, Տուփեր և ավելին ...
  • Քաղվածք տեքստ, Տեքստ ավելացնել, հեռացնել ըստ դիրքի, Հեռացնել տարածությունը; Ստեղծել և տպել էջային ենթագոտիներ; Փոխարկել բջիջների բովանդակության և մեկնաբանությունների միջև...
  • Սուպեր զտիչ (պահպանել և կիրառել ֆիլտրի սխեմաները այլ թերթերի վրա); Ընդլայնված տեսակավորում ըստ ամիս / շաբաթ / օր, հաճախականություն և ավելին; Հատուկ զտիչ համարձակ, շեղատառով ...
  • Միավորել աշխատանքային տետրերը և աշխատանքային թերթերը; Միավորել աղյուսակները ՝ հիմնված հիմնական սյունակների վրա; Տվյալները բաժանեք մի քանի թերթերի; Խմբաքանակի փոխակերպում xls, xlsx և PDF...
  • Ավելի քան 300 հզոր հատկություններ. Աջակցում է Office / Excel 2007-2021 և 365: Աջակցում է բոլոր լեզուներին: Հեշտ տեղակայում ձեր ձեռնարկությունում կամ կազմակերպությունում: Ամբողջական հնարավորություններ 30-օրյա անվճար փորձարկում: 60-օրյա գումարի վերադարձի երաշխիք:
kte էջանիշը 201905

Office Tab- ը Tabbed ինտերֆեյսը բերում է Office, և ձեր աշխատանքը շատ ավելի դյուրին դարձրեք

  • Միացնել ներդիրներով խմբագրումը և ընթերցումը Word, Excel, PowerPoint- ով, Հրատարակիչ, Access, Visio և Project:
  • Բացեք և ստեղծեք բազմաթիվ փաստաթղթեր նույն պատուհանի նոր ներդիրներում, այլ ոչ թե նոր պատուհաններում:
  • Բարձրացնում է ձեր արտադրողականությունը 50%-ով և նվազեցնում մկնիկի հարյուրավոր սեղմումները ձեզ համար ամեն օր:
officetab ներքևում

 

Տեսակավորել մեկնաբանությունները ըստ
մեկնաբանություններ (43)
Գնահատված 4.5- ը 5- ից դուրս է · 1 վարկանիշ
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Շատ օգտակար մակրո է, և այն լավ է աշխատում, բայց ես կցանկանայի, որ կարողանայի այդ թղթապանակից ընտրել, թե որ ֆայլերն եմ ուզում, որ մակրո գործարկվի: Ֆայլերը ավտոմատ կերպով չեն ստեղծվում առանձին թղթապանակում, և ես պետք է գործարկեմ տարբեր մակրոներ այդ թղթապանակից ֆայլերի յուրաքանչյուր հավաքածուի վրա, այնուհետև դրանք հետ տեղափոխեմ սկզբնական թղթապանակ:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Ես հետևեցի հրահանգներին, բայց ստացա կոմպիլյացիայի սխալ՝ «Loop without Do»: ինչ եմ պակասում: Իմ մակրո կոդը շատ պարզ է, պարզապես փոխեք նշված տողերի տառաչափը: Աշխատում է ինքնուրույն: Ահա թե ինչ ունեմ... խնդրում եմ օգնեք

Sub LoopThroughFiles ()
Dim xFd As FileDialog
Dim xFdItem որպես տարբերակ
Խոնավեցրեք xFileName-ը որպես տող
Սահմանել xFd = Application.FileDialog (msoFileDialogFolderPicker)
Եթե ​​xFd.Show = -1 Ապա
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xFileName = Dir(xFdItem & «*.xls*»)
Do while xFileName <> ""
Աշխատանքային տետրերով: Բաց (xFdItem & xFileName)
«Ձեր կոդը այստեղ է
Տողեր ("2:8"): Ընտրեք
Selection.Font-ով
.Անուն = «Արիալ»
.Չափ = 12
.Հարձակում = Սխալ
.Վերագիր = Սխալ
.Բաժանորդագրություն = Սխալ
.OutlineFont = Սխալ
.Shadow = Կեղծ
.Ընդգծել = xlUnderlineStyleՈչ
.Գույն = -11518420
.TintAndShade = 0
.ThemeFont = xlThemeFontՈչ
Վերջ
xFileName = Ռեժ
Հանգույց
Վերջ: Եթե
Վերջ Sub
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Բարև Յարտո
Դուք բաց եք թողել ձեր կոդի վերջում գտնվող «End with» սցենարը, ճիշտը պետք է լինի սա.
Sub LoopThroughFiles ()
Dim xFd As FileDialog
Dim xFdItem որպես տարբերակ
Խոնավեցրեք xFileName-ը որպես տող
Սահմանել xFd = Application.FileDialog (msoFileDialogFolderPicker)
Եթե ​​xFd.Show = -1 Ապա
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xFileName = Dir(xFdItem & «*.xls*»)
Do while xFileName <> ""
Աշխատանքային տետրերով: Բաց (xFdItem & xFileName)
«Ձեր կոդը այստեղ է
Տողեր ("2:8"): Ընտրեք
Selection.Font-ով
.Անուն = «Արիալ»
.Չափ = 16
.Հարձակում = Սխալ
.Վերագիր = Սխալ
.Բաժանորդագրություն = Սխալ
.OutlineFont = Սխալ
.Shadow = Կեղծ
.Ընդգծել = xlUnderlineStyleՈչ
.Գույն = -11518420
.TintAndShade = 0
.ThemeFont = xlThemeFontՈչ
Վերջ
Վերջ
xFileName = Ռեժ
Հանգույց
Վերջ: Եթե
Վերջ Sub

Խնդրում եմ փորձեք այն, հուսով եմ, որ այն կարող է օգնել ձեզ:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Շատ օգտակար մակրո է, և այն հիանալի է աշխատում, բայց ես կցանկանայի, որ կարողանայի այդ թղթապանակից ընտրել, թե որ ֆայլերն եմ ուզում, որ մակրո գործարկվի: Օրինակ, ես ունեմ 4 ֆայլ թղթապանակում այլ excel ֆայլերի հետ և ուզում եմ, որ այն աշխատի միայն այդ 4 կոնկրետ ֆայլերի վրա: Ինչպե՞ս կարող եմ կսմթել ձեր մակրոյում, որպեսզի թույլ տամ այդ թղթապանակից ընտրել այդ 4 ֆայլերը:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Բարև Ջոել,
Հատուկ աշխատանքային գրքերում նույն կոդը գործարկելու համար դուք պետք է կիրառեք հետևյալ կոդը.

Sub LoopThroughFiles ()
Dim xFd As FileDialog
Dim xFdItem որպես տարբերակ
Խոնավեցրեք xFileName-ը որպես տող
Dim xFB որպես լար
Application.FileDialog-ով (msoFileDialogOpen)
.AllowMultiSelect = Ճշմարիտ
.Զտիչներ.Մաքրել
.Filters.Add "excel", "*.xls*"
.Ցուցադրում
Եթե ​​.SelectedItems.Count < 1 Ապա Ելք Ենթ
lngCount = 1 To .SelectedItems.Count-ի համար
xFileName = .SelectedItems(lngCount)
Եթե ​​xFileName <> "" Ապա
Workbooks.Open-ով (Ֆայլի անուն:=xFileName)
«Ձեր կոդը
Վերջ
Վերջ: Եթե
Հաջորդ lngCount
Վերջ
Վերջ Sub

Խնդրում եմ փորձեք այն, հուսով եմ, որ այն կարող է օգնել ձեզ:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
շնորհակալություն, իսկապես օգտակար էր
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Hi!

Ես փորձում եմ տեղադրել իմ կոդը ձերի մեջ, և երբ գործարկում եմ մակրո, այն ինձ տալիս է հետևյալ հաղորդագրությունը. Գործարկման ժամանակի սխալ՝ «429». ActiveX-ը չի կարող ստեղծել օբյեկտը: Խնդրում ենք խորհուրդ տալ, թե ինչպես կարելի է այն շտկել: Շնորհակալություն!

Իմ կոդը.

Սահմանել RInput = Range («A2: A21»)
Սահմանել ROutput = Range («D2: D22»)

Dim A() Որպես տարբերակ
ReDim A (1 To RInput.Rows.Count, 0)
A = RInput.Value2

Սահմանել d = CreateObject («Scripsting.Dictionary»)

i = 1 Դեպի UBound (A) համար
Եթե ​​d.Exists(A(i, 1)) Ապա
d(A(i, 1)) = d(A(i, 1)) + 1
Ուրիշ
դ. Ավելացնել A(i, 1), 1
Վերջ: Եթե
հաջորդ
i = 1 Դեպի UBound (A) համար
A(i, 1) = d(A(i, 1))
հաջորդ

Ելք = Ա
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Բարև, նախ շնորհակալություն այս մակրոյի համար, դա հենց այն էր, ինչ ես փնտրում էի: Այնուամենայնիվ, ես ունեմ մեկ խնդիր, կա՞ տարբերակ փակելու և պահպանելու յուրաքանչյուր պատուհան, երբ այն ավարտվում է: Ես ունեմ մեծ քանակությամբ ֆայլեր, և RAM-ը սպառվում է մինչև կատարման ավարտը:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Այո, պարզապես ավելացրեք ստորև ձեր հետևյալ կոդը, եթե ցանկանում եք, որ այն պահպանի նույն անունով ֆայլը.

«Աշխատանքային գրքույկի պահպանում
ActiveWorkbook.Save
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Բարև Քեյթլին,
Միգուցե ստորև բերված կոդը կարող է օգնել ձեզ, ամեն անգամ, երբ ձեր հատուկ կոդը գործարկելուց հետո, կհայտնվի պահման ֆայլի հուշման տուփ, որը հիշեցնում է ձեզ պահպանել աշխատանքային գիրքը:

Sub LoopThroughFiles ()
Dim xFd As FileDialog
Dim xFdItem որպես տարբերակ
Խոնավեցրեք xFileName-ը որպես տող
Dim xWB-ը որպես աշխատանքային գրքույկ
Սահմանել xFd = Application.FileDialog (msoFileDialogFolderPicker)
Եթե ​​xFd.Show = -1 Ապա
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xFileName = Dir(xFdItem & «*.xls*»)
Ս.թ. սխալի Ռեզյումե Next
Do while xFileName <> ""
Սահմանել xWB = Workbooks.Open (xFdItem & xFileName)
xWB-ով
«Ձեր կոդը այստեղ է
Վերջ
xWB.Փակել
xFileName = Ռեժ
Հանգույց
Վերջ: Եթե
Վերջ Sub
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Hi!

Ես փորձում եմ տեղադրել իմ կոդը ձերի մեջ, և երբ գործարկում եմ մակրո, այն ինձ տալիս է հետևյալ հաղորդագրությունը. Գործարկման ժամանակի սխալ՝ «429». ActiveX-ը չի կարող ստեղծել օբյեկտը: Խնդրում ենք խորհուրդ տալ, թե ինչպես կարելի է այն շտկել: Շնորհակալություն!

Իմ կոդը.

Սահմանել RInput = Range («A2: A21»)
Սահմանել ROutput = Range («D2: D22»)

Dim A() Որպես տարբերակ
ReDim A (1 To RInput.Rows.Count, 0)
A = RInput.Value2

Սահմանել d = CreateObject («Scripsting.Dictionary»)

i = 1 Դեպի UBound (A) համար
Եթե ​​d.Exists(A(i, 1)) Ապա
d(A(i, 1)) = d(A(i, 1)) + 1
Ուրիշ
դ. Ավելացնել A(i, 1), 1
Վերջ: Եթե
հաջորդ
i = 1 Դեպի UBound (A) համար
A(i, 1) = d(A(i, 1))
հաջորդ

Ելք = Ա
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Բարեւ,

Ես հաջողությամբ օգտագործել եմ այս մակրոն՝ NBA ֆայլերը ձևավորելու համար 30 թիմերի համար, որոնցից յուրաքանչյուրն ունի իր գիրքը: Երեկ ես սխալի հաղորդագրություն ստացա այն մասին, որ մոդուլը (մակրո) չի կարող ավարտվել, ջնջվել կամ խմբագրվել (պահվել): Այն փչացրել է իմ անձնական մակրո աշխատանքային գրքույկը և Excel-ը գրեթե անօգտագործելի է դարձել ինձ համար: Այն խափանում է հավելվածը ամեն անգամ, երբ փորձում եմ որևէ ֆայլից մակրո մուտք գործել: Excel-ի և Windows-ի աջակցությունը չեն կարողացել շտկել խնդիրները: Կարող եք օգնել?
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Բարև, կա՞ տարբերակ, որով ես կարող եմ սահմանել ֆայլի նպատակակետը հենց սկրիպտում: Ես ուզում եմ բաց թողնել 3-րդ գործընթացը, որտեղ մենք պետք է թերթենք կոնկրետ թղթապանակը:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Բարև, շնորհակալություն այս կոդի համար: կարո՞ղ եք ասել ինձ, խնդրեմ, ինչպես կարող եմ ունենալ իմ մակրոյի արդյունքը, որի համար բացել եմ բոլոր աշխատանքային գրքույկները մեկ թերթիկում (յուրաքանչյուր աշխատանքային գրքի արդյունքը անընդմեջ): և կա՞ տարբերակ յուրաքանչյուր աշխատանքային գրքույկի անունը նախորդ քայլի տվյալներով տողում ավելացնելու համար:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Hi

Ես ստացա 1004 գործարկման ժամանակի սխալ. շարահյուսությունը ճիշտ չէ, երբ գործարկեցի հետևյալ կոդը, որը Extend Office VBA-ն է դեպի «Մակրո միաժամանակ մի քանի աշխատանքային գրքում VBA կոդով գործարկել» Extend Office VBA «Ջնջել բոլոր անվանված տիրույթները»: VBA կոդով» տեղադրեք ձեր ծածկագրի բնիկում.

Sub LoopThroughFiles ()

Dim xFd As FileDialog

Dim xFdItem որպես տարբերակ

Խոնավեցրեք xFileName-ը որպես տող

Սահմանել xFd = Application.FileDialog (msoFileDialogFolderPicker)

Եթե ​​xFd.Show = -1 Ապա

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

xFileName = Dir(xFdItem & «*.xls*»)

Do while xFileName <> ""

Աշխատանքային տետրերով: Բաց (xFdItem & xFileName)

«Ենթահեռացնել անունները()

«Թարմացնել 20140314

Dim xName As Name

Յուրաքանչյուր xName-ի համար Application.ActiveWorkbook.Names-ում

xName.Delete

հաջորդ


Վերջ

xFileName = Ռեժ

Հանգույց

Վերջ: Եթե

Վերջ Sub

Այն, ինչ ես փորձում եմ անել, մակրո գործարկելն է, որը ջնջում է անվանված միջակայքերը ութ աշխատանքային գրքույկներում, որոնք պարունակվում են նույն թղթապանակում:

BTW, սա առաջին անգամն է, որ ես ինչ-որ բան օգտագործում եմ Extend Office-ից և այն չի աշխատում: Այս կայքը չափազանց օգտակար է ինձ համար:

Առաջարկությունները/մեկնաբանությունները մեծապես երախտապարտ կլինեն:

ալդկ
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Բարև, ալդկ,
Ձեր կոդը լավ է աշխատում իմ աշխատանքային գրքում, Excel-ի ո՞ր տարբերակն եք օգտագործում:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Ողջույն, այս կոդը այնքան լավն է և օգտակար: Ես այն շատ եմ օգտագործում։

Այժմ իմ կազմակերպությունում մենք օգտագործում ենք SharePoint՝ մեր ֆայլերը պահելու համար: Կա՞ որևէ միջոց այս կոդը աշխատելու բոլոր ֆայլերի վրա sharepoint պանակում:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Ողջույն, շնորհակալություն այս ծածկագրի համար:
Կա՞ ենթաթղթապանակների միջով շրջանցելու միջոց: Ասենք, որ ես ունեմ մեկ թղթապանակ, իսկ թղթապանակում ևս տասը թղթապանակ, որոնցից յուրաքանչյուրը պարունակում է excel ֆայլ:

Կա՞ միջոց պարզապես ընտրելու հիմնական թղթապանակը, որպեսզի կոդը անցնի նրա բոլոր ենթաթղթապանակներով:

Շնորհակալություն:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Բարև, Դարկո, Ենթաթղթապանակներով թղթապանակից կոդ գործարկելու համար խնդրում ենք կիրառել հետևյալ կոդը. Sub LoopThroughFiles_Subfolders (xStrPath որպես տող)
Dim xSFolderName
Խոնավեցրեք xFileName-ը
Dim xArrSFPath() Որպես տող
Dim xI Որպես ամբողջ թիվ
Եթե ​​xStrPath = "" Ապա դուրս եկեք Sub
xFileName = Dir(xStrPath & «*.xls*»)
Do while xFileName <> ""
Workbooks.Open-ով (xStrPath և xFileName)
«Ձեր կոդը այստեղ է
Վերջ
xFileName = Ռեժ
Հանգույց
xSFolderName = Dir(xStrPath, vbDirectory)
xI = 0
ReDim xArrSFPath (0)
Do while xSFolderName <> ""
Եթե ​​xSFolderName <> "." Եվ xSFolderName <> «..» Հետո
Եթե ​​(GetAttr(xStrPath & xSFolderName) Եվ vbDirectory) = vbDirectory Ապա
xI = xI + 1
ReDim Պահպանել xArrSFPath(xI)
xArrSFPath(xI - 1) = xStrPath & xSFolderName & "\"
Վերջ: Եթե
Վերջ: Եթե
xSFolderName = Ռեժ
Հանգույց
Եթե ​​UBound(xArrSFPath) > 0 Ապա
xI-ի համար = 0 Դեպի UBound (xArrSFPath)
LoopThroughFiles_Subfolders (xArrSFPath(xI))
Հաջորդ xI
Վերջ: Եթե
Վերջ Sub
Sub LoopThroughFiles ()
Dim xFd As FileDialog
Dim xFdItem որպես տարբերակ
Խոնավեցրեք xFileName-ը որպես տող
Սահմանել xFd = Application.FileDialog (msoFileDialogFolderPicker)
Եթե ​​xFd.Show = -1 Ապա
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
LoopThroughFiles_Subfolders (xFdItem)
Վերջ: Եթե
Ավարտել ենթաԽնդրում ենք փորձել, հուսով եմ, որ դա կարող է օգնել ձեզ:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Բացի վերը նշված կոդից, հնարավո՞ր է բացել excel ֆայլերը իմ ուզած ժամանակագրական հաջորդականությամբ:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Ողջույն առաջին, շատ շնորհակալություն մակրոյի համար, որի հետ իսկապես հարմար է աշխատել: Ես պարզապես մտածում էի, թե արդյոք մենք ունենք մակրոյով onedrive-ի թղթապանակը թարմացնելու միջոց: Եթե ​​այո, խնդրում եմ ինձ տեղեկացրեք, թե ինչ կարող եմ անել այստեղ, որպեսզի թարմացնեմ ֆայլերը onedrive-ում մակրոսկրիպտի միջոցով:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Ողջույն, շատ շնորհակալ եմ այս սկրիպտի համար, ես ինձ համար շատ լավ է աշխատում, բայց ես հատուկ կարիքներ ունեմ. կա՞ տարբերակ փոխելու սկրիպտը՝ իմ կոդը ֆայլի անվան պայմաններով ԵՎ ենթաթղթապանակներում կիրառելու համար:
Ես բացատրում եմ. ես ուսուցիչ եմ և ստեղծել եմ Excel-ի լուծում՝ ուսանողների արդյունքները պահպանելու և ուսուցիչներին նրանց հետ խորհրդակցելու հնարավորություն տալու համար: Դա անելու համար ես ունեմ ֆայլ՝ յուրաքանչյուր դպրոցի առարկայի համար, և մեկ՝ պատասխանատու դասարանի համար, բոլորը՝ յուրաքանչյուր դասի թղթապանակում:
Այսպիսով, երբ ես հայտնաբերում եմ սխալ կամ օպտիմիզացում, ես պետք է զեկուցեմ բոլոր ենթաթղթապանակների բոլոր ֆայլերի փոփոխությունները:
Բայց քանի որ բոլոր ֆայլերը նույնը չեն (տարբեր սուբյեկտների կազմակերպություն), ես կցանկանայի մի միջոց կիրառել իմ կոդը՝ որպես օրինակ, բոլոր ենթաթղթապանակներում «maths class» անունով բոլոր ֆայլերի վրա, կամ ընդհակառակը, կիրառել իմ կոդը բոլոր ֆայլերի վրա: ենթաթղթապանակներում, բացառությամբ «xyz» անունով բոլոր ֆայլերի: Շնորհակալություն !Fabrice
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Ձեր տրված կոդը չի աշխատում հետևյալ VBA-ի հետ, կարող եք օգնել Sub Bundles()

Dim vWS As Worksheet-ը
Dim vA, vA2 ()
Dim vR այնքան երկար, vSum այնքան երկար, vC այնքան երկար
Dim vN այնքան երկար, vN2 այնքան երկար, vN3 այնքան երկար

Սահմանել vWS = ActiveSheet
vWS-ով
vR = .Cells(Rows.Count, 4).End(xlUp).Տող
vSum = Application.Sum(.Range("D2:D" & vR))
ReDim Պահպանել vA2 (1-ից vSum, 1-ից 4)
vA = .Range ("A2:D" & vR)
vN = 1-ից vR - 1-ի համար
vN2-ի համար = 1-ից մինչև vA(vN, 4)
vC = vC + 1
vN3 = 1-ից 4-ի համար
vA2(vC, vN3) = vA(vN, vN3)
Հաջորդ vN3
Հաջորդ vN2
Հաջորդ vN
Վերջ
vC = 1
vN = 1-ից մինչև vSum - 2
vA2 (vN, 4) = vC
Եթե ​​vA2(vN + 1, 2) = vA2(vN, 2) Ապա
vC = vC + 1
vA2 (vN + 1, 4) = vC
Ուրիշ
vA2 (vN + 1, 4) = 1
vC = 1
Վերջ: Եթե
Հաջորդ vN
Դիմում. ScreenUpdating = Սուտ է
Թերթիկներ.Ավելացնել
ActiveSheet- ով
vWS.Range("A1:D1").Պատճենել .Range("A1:D1")
Բջիջներ (2, 1). Չափափոխել (vSum, 4) = vA2
Վերջ
Դիմում. ScreenUpdating = ueիշտ է

Վերջ Sub
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Ես ուզում եմ այս VBA-ն գործարկել միաժամանակ մի քանի Թերթերի մեջ մի թղթապանակում, խնդրում եմ, helpSub Bundles()

Dim vWS As Worksheet-ը
Dim vA, vA2 ()
Dim vR այնքան երկար, vSum այնքան երկար, vC այնքան երկար
Dim vN այնքան երկար, vN2 այնքան երկար, vN3 այնքան երկար

Սահմանել vWS = ActiveSheet
vWS-ով
vR = .Cells(Rows.Count, 4).End(xlUp).Տող
vSum = Application.Sum(.Range("D2:D" & vR))
ReDim Պահպանել vA2 (1-ից vSum, 1-ից 4)
vA = .Range ("A2:D" & vR)
vN = 1-ից vR - 1-ի համար
vN2-ի համար = 1-ից մինչև vA(vN, 4)
vC = vC + 1
vN3 = 1-ից 4-ի համար
vA2(vC, vN3) = vA(vN, vN3)
Հաջորդ vN3
Հաջորդ vN2
Հաջորդ vN
Վերջ
vC = 1
vN = 1-ից մինչև vSum - 2
vA2 (vN, 4) = vC
Եթե ​​vA2(vN + 1, 2) = vA2(vN, 2) Ապա
vC = vC + 1
vA2 (vN + 1, 4) = vC
Ուրիշ
vA2 (vN + 1, 4) = 1
vC = 1
Վերջ: Եթե
Հաջորդ vN
Դիմում. ScreenUpdating = Սուտ է
Թերթիկներ.Ավելացնել
ActiveSheet- ով
vWS.Range("A1:D1").Պատճենել .Range("A1:D1")
Բջիջներ (2, 1). Չափափոխել (vSum, 4) = vA2
Վերջ
Դիմում. ScreenUpdating = ueիշտ է

Վերջ Sub
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Ես փորձեցի գործարկել կոդը, բայց սխալը «424: Object Required» հայտնվում է «With Workbooks.Open(xFdItem & xFileName)» տողում: Ավելի խորը նայելով՝ պարզվում է, որ հետաքրքրող թղթապանակում պահվող excels աշխատանքային գրքույկները չեն ցուցադրվում/գոյություն ունեն (Երբ պատուհանը բացվում է կոդի ցուցադրմամբ, եթե ես փորձում եմ բացել թղթապանակը և չընտրել այն, այն դատարկ է): Ինչու այդպես?
Sub LoopThroughFiles ()
Dim xFd As FileDialog
Dim xFdItem որպես տարբերակ
Խոնավեցրեք xFileName-ը որպես տող
Սահմանել xFd = Application.FileDialog (msoFileDialogFolderPicker)
Եթե ​​xFd.Show = -1 Ապա
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xFileName = Dir(xFdItem & «*.xls*»)
Do while xFileName <> ""
Աշխատանքային տետրերով: Բաց (xFdItem & xFileName)
Sheets.Add After:=ActiveSheet
Թերթեր («Թերթ2»): Ընտրեք
Թերթեր ("Seet2").Անուն = "Master"
Թերթեր («Վարպետ»): Ընտրեք
Թերթեր ("Master"). Տեղափոխել առաջ:=Թերթիկներ (1)
Վերջ
xFileName = Ռեժ
Հանգույց
Վերջ: Եթե
Վերջ Sub


Խնդրում եմ, կարող եք օգնել ինձ լուծել այս խնդիրը:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Սա իմ սիրելի վեբկայքն է՝ բացարձակ ամենապարզ հրահանգներով (ավելի շատ, քան YouTube-ի ցանկացած տեսանյութ), և ես անընդհատ վերադառնում եմ դրան: Շատ շնորհակալ եմ այս ձեռնարկների համար. դու տխուր շրջանավարտի փրկիչ ես:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Sub LoopThroughFiles ()
Dim xFd As FileDialog
Dim xFdItem որպես տարբերակ
Խոնավեցրեք xFileName-ը որպես տող
Սահմանել xFd = Application.FileDialog (msoFileDialogFolderPicker)
Եթե ​​xFd.Show = -1 Ապա
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xFileName = Dir(xFdItem & «*.xls*»)
Do while xFileName <> ""
Աշխատանքային տետրերով: Բաց (xFdItem & xFileName)
ActiveCell.Offset(0, 1).Columns("A:A").EntireColumn.Select
Selection.Insert Shift:=xlToRight
ActiveCell.Select
Վերջ
xFileName = Ռեժ
Հանգույց
Վերջ: Եթե
End Sub, խնդրում եմ օգնեք: BTW, իմ excel ֆայլերի ընդլայնումն է (.csv - «ստորակետով սահմանազատված»): և ես ունեմ 500 excel ֆայլ թղթապանակում, որոնց յուրաքանչյուր տողում միջինը կազմում է մոտ 500000 տող: Խնդրում ենք օգնել: Ես պարզապես ուզում եմ սյունակ տեղադրել յուրաքանչյուր աշխատանքային գրքում
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
երբևէ ստացե՞լ եք ձեր հարցի պատասխանը: Ես փորձում եմ նույն բանն անել ավելի քան 3700 csv ֆայլերի հետ: Ես պարզապես պետք է ավելացնեմ 1 սյունակ (A):
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Ողջույն, կարիքավոր և Կարլի: Ձեր խնդիրը լուծելու համար մի քանի CSV ֆայլերի կոդը գործարկելու համար դուք պարզապես պետք է փոխեք .xls ֆայլի ընդլայնումը դեպի .csv, ինչպես ցույց է տրված ստորև նշված կոդը: Sub LoopThroughFiles ()
Dim xFd As FileDialog
Dim xFdItem որպես տարբերակ
Խոնավեցրեք xFileName-ը որպես տող
Սահմանել xFd = Application.FileDialog (msoFileDialogFolderPicker)
Եթե ​​xFd.Show = -1 Ապա
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xFileName = Dir(xFdItem & «*.csv*»)
Do while xFileName <> ""
Աշխատանքային տետրերով: Բաց (xFdItem & xFileName)
ActiveCell.Offset(0, 1).Columns("A:A").EntireColumn.Select
Selection.Insert Shift:=xlToRight
ActiveCell.Select
Վերջ
xFileName = Ռեժ
Հանգույց
Վերջ: Եթե
Ավարտել ենթաԽնդրում ենք փորձել, հուսով եմ, որ դա կարող է օգնել ձեզ:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Ողջույն, հնարավո՞ր է մակրոն գործարկել միայն տարբեր աշխատանքային գրքույկների թերթերում՝ կոնկրետ անունով։ շնորհակալություն!!
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Բարև Սառա,
Կներեք, ձեր բարձրացրած խնդրին լավ լուծում չկա:
Thank you!
Առայժմ ոչ մի մեկնաբանություն չկա
Բեռնել More
Թողեք ձեր մեկնաբանությունները
Հրապարակում որպես հյուր
×
Գնահատեք այս գրառումը.
0   Անձնավորություններ
Առաջարկվող վայրեր

Հետեւեք մեզ

Հեղինակային իրավունքի © 2009 - www.extendoffice.com. | Բոլոր իրավունքները պաշտպանված են. Powered by ExtendOffice. | | Կայքի քարտեզ
Microsoft- ը և Office- ի պատկերանշանը հանդիսանում են Microsoft Corporation- ի ապրանքային նշաններ կամ գրանցված ապրանքային նշաններ ԱՄՆ-ում և (կամ) այլ երկրներում:
Պաշտպանված է Sectigo SSL- ի կողմից