Макро / VBA для циклу та пропуску аркушів на основі значення комірки


0

Може хтось допоможе мені з макросом / VBA, оскільки те, про що я прошу, є для мене трохи просунутим.

У мене є робоча книга Excel з 10 аркушами даних.

Макрос я в основному переформатує і змінює деякі елементи на аркуші, його досить базовий, але він робить свою роботу.

Раніше у мене був лише 1 аркуш, але зараз у мене є 10 аркушів, мені потрібен мій макрос, щоб прокрутити аркуші та внести однакові зміни на кожен аркуш, АЛЕ ТОЛЬКО, якщо аркуш НЕ містить значення "UK" у комірці A1. Якщо аркуш містить Великобританію у комірці A1, я хочу, щоб він пропустив цей аркуш, не вносив жодних змін і переходив до наступного.

На приклад, скажімо, що я хочу видалити стовпчик Н і змінити колір тексту на червоний. Як мені це зробити за допомогою правил, які я виклав вище?

Сподіваюся, це має сенс.

Спасибі заздалегідь

FYI я використовую excel 2016

ОНОВЛЕННЯ:

Макрос, який я записав, такий;

Sub Sort_Data()
'
' Sort_Data Macro
'

'
    Sheets("Sheet2").Select
    Columns("AG:AI").Select
    Selection.Delete Shift:=xlToLeft
    Columns("AE:AE").Select
    Selection.Delete Shift:=xlToLeft
    Columns("H:AA").Select
    Range("AA1").Activate
    Selection.Delete Shift:=xlToLeft
    Columns("E:E").Select
    Selection.Cut
    Columns("B:B").Select
    Selection.Insert Shift:=xlToRight
    Columns("J:M").Select
    Selection.Cut
    Columns("H:H").Select
    Selection.Insert Shift:=xlToRight
    Columns("B:B").Select
    Selection.Copy
    Columns("P:P").Select
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    Columns("P:P").Select
    Application.CutCopyMode = False
    ExecuteExcel4Macro _
        "FORMULA.REPLACE(""$"","""",2,1,FALSE,FALSE,,FALSE,FALSE,FALSE,FALSE)"
    Range("Q2").Select
    ActiveCell.FormulaR1C1 = "=RC[-1]/RC[-9]"
    Selection.AutoFill Destination:=Range("Q2:Q6")
    Range("Q2:Q6").Select
    Columns("H:H").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("R:R").Select
    Selection.Copy
    Columns("H:H").Select
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    Columns("Q:R").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    Range("H1").Select
    ExecuteExcel4Macro "PATTERNS(0,0,0,,2,2,0,0)"
    Selection.Locked = True
    Selection.FormulaHidden = False
    ActiveCell.FormulaR1C1 = "Efficiency"
    Columns("B:O").Select
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .MergeCells = False
    End With
    Cells.Select
    Selection.Columns.AutoFit
    Range("A1").Select
End Sub

Я спробував і не використав пояснювану тут функцію циклу:

Підтримка Microst

Але я просто не можу це зрозуміти. І я поняття не маю, що так, як реалізувати "пропуск аркушів на основі значення А1"

Дякую


Чи можете ви показати нам, що ви зробили досі? У тому числі макрос.
Вилікс

привіт @Vylix Я щойно редагував, як просили
JezVanderBrown

Відповіді:


0

Це можна зробити досить просто, щоб ви могли просто запустити одне виконання коду VBA, а не на основі аркуша.

Public Sub AmendSheets()
    Dim i As Integer
' Start a count to go from sheet 1 to the total number of sheets
    For i = 1 To Application.Sheets.Count
' Select each sheet individually
    Worksheets(i).Activate

' Check for UK to see if changes are required
    If Range("A1").Value <> "UK" Then
' Put your changes in here

      End If
    Next i
End Sub

0

Це рішення, яке вам потрібно:

Public Function SheetReview()
    Dim wkb As Workbook
    Dim wks As Worksheet
    Set wkb = ThisWorkbook 'This object references the workbook
    wscount = wkb.Worksheets.Count 'Number of sheets in the workbook
    For i = 1 To wscount ' Loop one by one the sheets
        Set wks = wkb.Worksheets(i) 'Assign the current sheeet to object wks
        If wks.Cells(1, 1) <> "UK" Then ' If cell A1 is not UK
            With wks 'Let's work on the object wks
                '**********************
                'From here goes you code:
                'Sheets("Sheet2").Select <- Now you don't need this. it's referenced in the object wks
                Columns("AG:AI").Select
                Selection.Delete Shift:=xlToLeft
                .
                .
                .






            End With
        End If
    Next i
End Function

Відкрийте VBA / Макроси за допомогою Alt+ F11, клацніть правою кнопкою миші Робочу книгу та вставте новий модуль .

Вставте код у правій частині.

Використовуючи наш веб-сайт, ви визнаєте, що прочитали та зрозуміли наші Політику щодо файлів cookie та Політику конфіденційності.
Licensed under cc by-sa 3.0 with attribution required.