Почему критерии фильтрации не фильтруют ничего?

Question

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

Sub Mail_Selection_Range_Outlook_Body()

Dim Rng As Range
Dim OutApp As Object
Dim OutMail As Object
Dim xAddress As String
Dim a As String


With Application
    .EnableEvents = False
    .ScreenUpdating = False
End With

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

With OutMail
    .Display
    .To = "ME@ME.COM"
    .CC = ""
    .BCC = ""
    .Subject = "This is the Subject line"
    .htmlbody = "Hi All" & "<br>"
For i = 1 To Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row
    ActiveWorkbook.Sheets(2).Activate
    a = Sheets("Sheet2").Range("A" & i).Value
    If ActiveSheet.Range("A" & i).Value Like "GBL?*" Then
        Set Rng = Nothing
        .htmlbody = .htmlbody & a & Chr(9) & "Projects" & RangetoHTML(Range("A1:H78")) & "<br>"
    End If
Next i
.Display
End With
On Error GoTo 0

With Application
    .EnableEvents = True
    .ScreenUpdating = True
End With

Set OutMail = Nothing
Set OutApp = Nothing
End Sub


Function RangetoHTML(Rng As Range)
' By Ron de Bruin.
Dim fso As Object
Dim ts As Object
Dim TempFile As String
Dim TempWB As Workbook


ActiveWorkbook.Sheets(1).Activate

If ActiveSheet.AutoFilterMode Then
    ActiveSheet.AutoFilterMode = False
End If

ActiveWorkbook.Sheets(1).Activate
ActiveSheet.Range("A1:H1").AutoFilter Field:=2, Criteria1:="=" & a, Operator:=xlFilterValues

Set Rng = Range("A1", ActiveSheet.Range("H" & Rows.Count).End(xlUp))

TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"

'Copy the range and create a new workbook to past the data in
Rng.Copy
Set TempWB = Workbooks.add(1)
With TempWB.Sheets(1)
    .Cells(1).PasteSpecial Paste:=8
    .Cells(1).PasteSpecial xlPasteValues, , True, False
    .Cells(1).PasteSpecial xlPasteFormats, , True, False
    .Cells(1).Select
    Application.CutCopyMode = False
    On Error Resume Next
    .DrawingObjects.Visible = True
    .DrawingObjects.Delete
    On Error GoTo 0
End With

'Publish the sheet to a htm file
With TempWB.PublishObjects.add( _
     SourceType:=xlSourceRange, _
     Filename:=TempFile, _
     Sheet:=TempWB.Sheets(1).Name, _
     Source:=TempWB.Sheets(1).UsedRange.Address, _
     HtmlType:=xlHtmlStatic)
    .Publish (True)
End With

'Read all data from the htm file into RangetoHTML
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
RangetoHTML = ts.ReadAll
ts.Close
RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
                      "align=left x:publishsource=")

'Close TempWB
TempWB.Close savechanges:=False

'Delete the htm file we used in this function
Kill TempFile

Set ts = Nothing
Set fso = Nothing
Set TempWB = Nothing
End Function

Токовый выход, как показано здесь

однако ожидаемый результат должен иметь такие таблицы

* +1012 *

под каждым именем проекта.

Почему он не принимает критерии 1 в качестве значения ячейки правильно?

Answer 1

В вашем коде переменная a назначена в Sub Mail_Selection_Range_Outlook_Body с a = Sheets("Sheet2").Range("A" & i).Value.

Однако, в RangeToHtml он используется здесь - ActiveSheet.Range("A1:H1").AutoFilter Field:=2, Criteria1:="=" & a, Operator:=xlFilterValues, но он не назначен ни для чего.Область действия переменной находится только в Mail_Selection_Range_Outlook_Body Таким образом, критерий не работает.

---

Что должно быть сделано?

• используйте Option Explicit, чтобы избежать использования необъявленных переменных.VBEditor сообщит сразу, как только что-то не будет объявлено;

• убедитесь, что имена переменных указаны правильно.a не является хорошим именем;

• попробуйте отладить и посмотреть значения переменных.Отладка выполняется пошагово с помощью F8 , и Debug.Print a поможет вам увидеть текущее значение;

• попытайтесь написать что-то вроде MCVE , просто для себя, используя как можно меньше кода.Тогда, вероятно, отладка будет проще.