Найти / заменить ограничено одним столбцом, но несколькими листами

Question

Я начну с того, что говорю, что единственный VBA, который я знаю, это метод проб и ошибок от манипулирования записанными макросами. Я CPA, пытаюсь выучить VBA трудным путем (и хочу, чтобы вместо этого я пошел в школу по программированию!).

У меня большие рабочие тетради с несколькими листами. Ячейки, выделенные желтым цветом в столбце G, должны быть отформатированы особым образом для правильного импорта файла в веб-программу. Они должны оставаться выделенными желтым цветом, быть выровненными по правому / нижнему краям и иметь собственный формат мм / дд / гггг. Я записал макрос, выполняющий поиск / замену, чтобы попытаться заменить все подсвеченные желтым цветом ячейки в столбце G подсвеченным желтым, с выравниванием по нижнему / правому краям, пользовательский формат мм / дд / гггг, но он не ограничивает замену только столбцом G. У меня также есть Понятия не имею, как заставить макрос перебрать все листы до завершения. Помогите?!

Вот что у меня есть из моей основной записи макросов:

Sub Macro2()
'
' Macro2 Macro
'

'
    Columns("G:G").Select
    Range("G:G").Activate
    With Application.FindFormat.Interior
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Application.ReplaceFormat.Clear
    Application.ReplaceFormat.NumberFormat = "mm/dd/yyyy"
    With Application.ReplaceFormat
        .HorizontalAlignment = xlRight
        .VerticalAlignment = xlBottom
    End With
    With Application.ReplaceFormat.Font
        .Subscript = False
        .TintAndShade = 0
    End With
    With Application.ReplaceFormat.Interior
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Cells.Replace What:="", Replacement:="", LookAt:=xlPart, SearchOrder:= _
        xlByRows, MatchCase:=False, SearchFormat:=True, ReplaceFormat:=True
End Sub

РЕДАКТИРОВАНИЕ ПОСЛЕ ДОБАВЛЕНИЯ: Пожалуйста, смотрите скриншот типичного листа, который я пытаюсь переформатировать. Опять же, мне нужно беспокоиться только об изменении форматирования в ячейках, которые выделены желтым цветом, но у меня все еще возникают проблемы с ограничением поиска / замены только для столбца G... [1]: [

Answer 1

Если вы пытаетесь разобраться в записанном коде, первое, что нужно сделать, это избавиться от всего лишнего, подробного кода, который был добавлен, но ничего не делает. Записанный код охватывает все аспекты операции, независимо от того, требуются они вам или нет.

Это переписать ваш оригинал, используя только то, что требуется.

Sub yellowSpecialReplace()
    Dim w As Long

    Application.DisplayAlerts = False

    With Application.FindFormat
        .Clear
        .Interior.Color = 65535
    End With
    With Application.ReplaceFormat
        .Clear
        .NumberFormat = "mm/dd/yyyy"
        .HorizontalAlignment = xlRight
        .VerticalAlignment = xlBottom
    End With

    With ActiveWorkbook
        For w = 1 To .Worksheets.Count
            With Worksheets(w).Columns("G:G")
                .Cells.Replace What:=vbNullString, Replacement:=vbNullString, _
                               LookAt:=xlPart, SearchOrder:=xlByRows, _
                               SearchFormat:=True, ReplaceFormat:=True
            End With
        Next w
    End With

    Application.DisplayAlerts = True
End Sub

Answer 2

Вот код, который, кажется, делает то, что вы описываете. Я поместил много .select операторы в коде, чтобы вы могли узнать, как это работает, пройдя его, но вы должны удалить все те, которые вы понимаете. Кроме того, у меня есть закомментированный код внизу, который вы можете использовать для циклического прохождения нескольких листов. Анимированный GIF показывает код, запущенный на примере, который я составил. Дайте мне знать, если у вас есть вопросы.

Sub reformat()
Dim sh As Worksheet, r As Range, cell As Range
  Set sh = ActiveSheet
  Set r = sh.Range("G1")
  r.Select
  If r.Offset(1, 0) <> "" Then Set r = sh.Range(r, r.End(xlDown))
  r.Select
  For Each cell In r
    With cell
      .Select
      If .Interior.Color = 65535 Then
        .HorizontalAlignment = xlRight
        .VerticalAlignment = xlBottom
        .NumberFormat = "mm/dd/yyyy"
      End If
    End With
  Next
For Each sh In ThisWorkbook.Worksheets
'place the above code in this loop if you want
'to apply the above to all worksheets in the workbook
'also remove the set sh=ActiveSheet line
Next sh
End Sub

Answer 3

Прокрутите каждый лист в активной книге, затем Автофильтр на цвете ячейки, затем примените изменения к видимым ячейкам.

sub yellowSpecial()
    dim w as long

    with activeworkbook
        for w=1 to .worksheets.count
            with worksheets(w)
                if .autofiltermode then .autofiltermode = false
                with .range(.cells(1, "G"), .cells(.rows.count, "G").end(xlup))
                    .autofilter field:=1, criteria1:=vbyellow, operator:=xlFilterCellColor
                    with .resize(.rows.count-1, .columns.count).offset(1,0)
                        if cbool(application.subtotal(103,.cells)) then
                            with .specialcells(xlcelltypevisible)
                                .HorizontalAlignment = xlRight
                                .VerticalAlignment = xlBottom
                                .numberformat = "mm/dd/yyyy"
                            end with
                        end if
                    end with
                end with
                if .autofiltermode then .autofiltermode = false
            end with
        next w
    end with
end sub