Question

我已经为自动过滤国家/地区代码创建了宏，并根据这些国家/地区的语言将它们拆分为不同的标签，我使用所选范围的自动过滤属性来执行此操作。

我想要提供可能不包含任何国家/地区代码的电子表格，如果是自动过滤器，则标准＆lt;＆gt; 0。

我不知道该怎么做。任何帮助或指示将不胜感激

Dim sEnglish            As String
Dim rRange              As Range

sEnglish = "GI,GB,GG,VG"

Sheets("Distribution").Select

'EXTRACT ENGLISH

ary = Split(sEnglish, ",")

Set rRange = Range("H1:H38")
With rRange
    .AutoFilter
    .AutoFilter Field:=1, Criteria1:=(ary), Operator:=xlFilterValues
End With

Rows("1:1").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToLeft)).Select
Selection.Copy
Sheets.Add.Name = "English"
Sheets("English").Select
ActiveSheet.Paste
Sheets("English").Columns.AutoFit
Sheets("Distribution").Select

Answer 1

Sub SHM_Distribution()

' declare variables for country codes

Dim sBelFrench          As String
Dim sEnglish            As String
Dim sFrench             As String
Dim sGerman             As String
Dim sHKEng              As String
Dim sHKEngChinese       As String
Dim sSpanish            As String
Dim sItalian            As String

' declare variables for languages.  Will be used later for tab names

Dim sBelFrenLang        As String
Dim sEngLang            As String
Dim sFrenLang           As String
Dim sGerLang            As String
Dim sHKEngLang          As String
Dim sHKEngChinLang      As String
Dim sSpanLang           As String
Dim sItalLang           As String

Dim rRange              As Range
Dim iCount              As Integer

'Country codes

sBelFrench = "BE"
sEnglish    = "AU,BM,BO,BS,CA,CN,CY,EG,GB,GG,IE,IL,IM,JE,JP,KW,KY,LB,LI,MY,NL,NO,OM,PK,PT,SA,SC,SG,TH,US,VG,VI,ZA,AE"
sFrench = "FR"
sGerman = "AT, CH, DE"
sHKEng = "TW"
sHKEngChinese = "HK"
sSpanish = "ES"
sItalian = "IT"

'Strings for tab names

sBelFrenLang = "Belgian French"
sEngLang = "English"
sFrenLang = "French"
sGerLang = "German"
sHKEngLang = "HK English"
sHKEngChinLang = "HK English Chinese"
sSpanLang = "Spanish"
sItalLang = "Italian"

'activate primary sheet

Sheets("Distribution").Select

' get total rows of active sheet

iCount = Application.COUNTA(Range("A:A"))

'call extract routine and pass country code and tab name strings

Call Extract(sBelFrench, sBelFrenLang, iCount)
Call Extract(sEnglish, sEngLang, iCount)
Call Extract(sFrench, sFrenLang, iCount)
Call Extract(sGerman, sGerLang, iCount)
Call Extract(sHKEng, sHKEngLang, iCount)
Call Extract(sHKEngChinese, sHKEngChinLang, iCount)
Call Extract(sSpanish, sSpanLang, iCount)
Call Extract(sItalian, sItalLang, iCount)

'turn off autofulter and deselect

Sheets("Distribution").AutoFilterMode = False
Application.CutCopyMode = False

End Sub

Sub Extract(sCode As String, sLang As String, iTotalRows As Integer)

' ary is an array string used by autofilter
' populate ary using passed country code value and separate each by a comma

ary = Split(sCode, ",")

'set range for autofilter

Set rRange = Range("H1:H" & iTotalRows)

With rRange

    'turn on autofilter and select values of ary, in this case passed country code values from parent routine

    .AutoFilter
    .AutoFilter Field:=1, Criteria1:=(ary), Operator:=xlFilterValues

End With

'get visible row count

iVisibleRows = (ActiveSheet.AutoFilter.Range.SpecialCells(xlCellTypeVisible).Count / ActiveSheet.AutoFilter.Range.Columns.Count) - 1

'if visible rows is zero then do not create a new sheet

If iVisibleRows <> 0 Then

    'prep filtered data for copy
    'select filtered area

    Rows("1:1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToLeft)).Select

    'copy selection

    Selection.Copy

    'add new sheet using passed string value of language

    Sheets.Add.Name = sLang

    'activate new sheet

    Sheets(sLang).Select

    'paste selection to new sheet

    ActiveSheet.Paste

    'autofit columns

    Sheets(sLang).Columns.AutoFit

    'select primary distribution sheet for next run

    Sheets("Distribution").Select
Else

    Sheets("Distribution").Select
End If

End Sub

Answer 2

试试这个

Option Explicit '<~~ it's better to always use this statement

Sub Main()

    Dim sEnglish            As String
    Dim rRange              As Range
    Dim ary                 As Variant '<~~ declare it as a variant

    'EXTRACT ENGLISH
    sEnglish = "GI,GB,GG,VG"
    ary = Split(sEnglish, ",")

    Set rRange = Sheets("Distribution").Range("H1:H38") '<~~ don't use "Select" or "Activate" and just use fully qualified reference to a range, down to its sheet and even its workbook if needed
    With rRange
        .AutoFilter
        .AutoFilter Field:=1, Criteria1:=ary, Operator:=xlFilterValues
        If Application.WorksheetFunction.Subtotal(103, .Cells) > 1 Then '<~~ check to see if there's more than one visible cell in rRange (being header cell always visible after any filtering)
            Sheets.Add.Name = "English"
            With .SpecialCells(xlVisible) '<~~ consider only visible (filtered) cells
                .Copy '<~~ copy them
                Sheets("English").Paste '<~~ paste in "English" sheet, from "A1" cell
                Sheets("English").Columns.AutoFit
            End With
        End If
    End With

End Sub

Excel VBA - Autofilter Criteriea为空

2 个答案: