VBAコード償却。さまざまなワークブックの列ヘッダーの変更

Question

私はあなたが助けてくれることを願っています。私はうまく動作するいくつかのコードがあります。ダイアログボックスを開くと、このファイルが選択されると、ユーザーはExcelファイルを選択できます。列見出しは、その後、国に基づいて、新しいワークシートに列Fを分離は、この列が列Fにそれを置くカットテキスト「国番号」を見つけて

コードが見えます。

私が直面しています。この問題は、時々私はカットしたい列をテキスト「ClientField10」または「ClientField1」

だから私は何をするマクロを希望する列を検索している含まれていることです"CountryCode"の見出しが見つかった場合は、残りのコードを実行します。

それがある場合ませた後、「CleintField10」のための検索を実行し、どちらも「CountyCode」または「CleintField10」が発見された場合「CleintField1」の検索が、その後の残りの部分を実行した場合コード

私のコードはいつもどんな助けも大歓迎です。

Sub Open_Workbook_Dialog() 

Dim my_FileName As Variant 
Dim my_Workbook As Workbook 

    MsgBox "Pick your TOV file" '<--| txt box for prompt to pick a file 

    my_FileName = Application.GetOpenFilename(FileFilter:="Excel Files,*.xl*;*.xm*") '<--| Opens the file window to allow selection 

    If my_FileName <> False Then 
    Set my_Workbook = Workbooks.Open(Filename:=my_FileName) 

    Call Sample(my_Workbook) '<--|Calls the Filter Code and executes 

    Call Filter(my_Workbook) '<--|Calls the Filter Code and executes 

    End If 
End Sub 

Public Sub Sample(my_Workbook As Workbook) 
    Dim ws As Worksheet 
    Dim aCell As Range, Rng As Range 
    Dim col As Long, lRow As Long 
    Dim colName As String 

    '~~> Change this to the relevant sheet 
    Set ws = my_Workbook.Sheets(1) 
    With ws 
    Set aCell = .Range("A1:BB50").Find(What:="CountryCode", LookIn:=xlValues, LookAt:=xlWhole, _ 
       MatchCase:=False, SearchFormat:=False) 
    '~~> If Found 
    If Not aCell Is Nothing Then 
     '~~> Cut the entire column 

     aCell.EntireColumn.Cut 

     '~~> Insert the column here 

     Columns("F:F").Insert Shift:=xlToRight 
    Else 
     MsgBox "Country Not Found" 
    End If 
    End With 
End Sub 

Public Sub Filter(my_Workbook As Workbook) 
    Dim rCountry As Range, helpCol As Range 

    With my_Workbook.Sheets(1) '<--| refer to data worksheet 
    With .UsedRange 
     Set helpCol = .Resize(1, 1).Offset(, .Columns.Count) '<--| get a "helper" column just at the right of used range, it'll be used to store unique country names in 
    End With 

    With .Range("A1:Q" & .Cells(.Rows.Count, 1).End(xlUp).Row) '<--| refer to its columns "A:Q" from row 1 to last non empty row of column "A" 
     .Columns(6).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=helpCol, Unique:=True '<-- call AdvancedFilter on 6th column of the referenced range and store its unique values in "helper" column 
     Set helpCol = Range(helpCol.Offset(1), helpCol.End(xlDown)) '<--| set range with unique names in (skip header row) 
     For Each rCountry In helpCol '<--| iterate over unique country names range (skip header row) 
     .AutoFilter 6, rCountry.Value2 '<--| filter data on country field (6th column) with current unique country name 
     If Application.WorksheetFunction.Subtotal(103, .Cells.Resize(, 1)) > 1 Then '<--| if any cell other than header ones has been filtered... 
      Worksheets.Add Worksheets(Worksheets.Count) '<--... add new sheet 
      ActiveSheet.Name = rCountry.Value2 '<--... rename it 
      .SpecialCells(xlCellTypeVisible).Copy ActiveSheet.Range("A1") 'copy data for country under header 
     End If 
     Next 
    End With 
    .AutoFilterMode = False '<--| remove autofilter and show all rows back 
    End With 
    helpCol.Offset(-1).End(xlDown).Clear '<--| clear helper column (header included) 
End Sub 

Answer 1

私は前に自分のコードをテストするために取得していないので、私が代わりに「ElseIfステートメント」文の「場合」を使用しての愚かなミスを犯しました。私は以下のコードをテストし、今は動作します。

Sub test() 
Dim acell As Range 
Dim ws As Worksheet 
Set ws = ActiveWorkbook.Sheets(1) 'define ws 
Set acell = ws.Range("A1:BB50").Find(What:="CountryCode", LookIn:=xlValues, LookAt:=xlWhole, _ 
MatchCase:=False, SearchFormat:=False) 'define acell as location of "countrycode" 

If Not acell Is Nothing Then  'if address is found do the cut & insert of that column 
    acell.EntireColumn.Cut 
    Columns("F:F").Insert Shift:=xlToRight 
ElseIf acell Is Nothing Then   'if address is not found redefine acell to look for "clientfield10" 
    Set acell = ws.Range("A1:BB50").Find(What:="ClientField10", LookIn:=xlValues, LookAt:=xlWhole, _ 
    MatchCase:=False, SearchFormat:=False) 

    If Not acell Is Nothing Then 'if address is found do the cut & insert 
     acell.EntireColumn.Cut 
     Columns("F:F").Insert Shift:=xlToRight 
    ElseIf acell Is Nothing Then 'If not found redefine acell again to look for "ClientField1" 
      Set acell = ws.Range("A1:BB50").Find(What:="ClientField1", LookIn:=xlValues, LookAt:=xlWhole, _ 
      MatchCase:=False, SearchFormat:=False) 

      If Not acell Is Nothing Then 'If found do cut and insert 
      acell.EntireColumn.Cut 
      Columns("F:F").Insert Shift:=xlToRight 
      Else: MsgBox "Country Not Found" 'If none can be found display msgbox 
      End If 
    End If 
End If 'close all the If loops 
End Sub 

私はここに私の友人を