2016-05-26 13 views
0

私は国コードをオートフィルタするマクロを作成し、それらの国の言語に基づいて別のタブに分割し、選択した範囲のautofilterプロパティを使用します。Excel VBA - オートフィルタCriterieaがnull

国コードを含まないスプレッドシートをご希望の場合は、オートフィルタの場合は<> 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 

答えて

0
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 
0

をいただければ幸いです。この

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 

関連するステップが、私はそれはいくつかにあなたを強制することを追加します、Option Explicit用として

をコメントしているしてみてくださいすべての変数を宣言するための余分な作業がありますが、報酬はコードとデバッグ時のスペアリングを完全に制御します

+0

@ user3364233あなたはそれを通過しましたか? – user3598756

+0

ありがとうございます。間違いなく、ループ内のすべてのステップが含まれており、明示的なオプションを覚えています。私はまもなく私の完全なルーチンを投稿します。さまざまな言語のカテゴリと国コードの数を考えると、コードには多くの繰り返しがあります。代わりに、変数が親ルーチンから渡されると、タブの作成やコピーの貼り付けなどの主要な作業を行うルーチンを呼び出します。入力をありがとう – user3364233

+0

私は実際に自分の質問に答えた!昨日投稿した私の他の回答(ユーザーuser3364233)を参照してください。 Subの開始はSub SHM_Distribution()です。元の質問で自分の答えを更新する必要がありますか? – user3364233

関連する問題