Блог

Я надеюсь, что вы сможете помочь. У меня есть некоторый код ниже, который работает нормально. Что он делает, так это открывает диалоговое окно, позволяющее пользователю выбрать файл 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" amp; .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
  

Поскольку я раньше не тестировал свой код, я допустил глупую ошибку, используя «If» вместо операторов «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 amp; 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 amp; 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
  

Я удалю свой старый ответ, чтобы упростить понимание этой темы