Как скрыть несколько столбцов в нескольких листах - PullRequest
0 голосов
/ 26 мая 2019

Я просматриваю 25 рабочих книг в определенном каталоге, и мне нужно скрыть одни и те же столбцы в каждой рабочей книге.

Я настроил код так, чтобы он циклически проходил по каждой книге, но он не работает, когда дело доходит до скрытия столбцов. Я сделал поиск в Google, но что-то упустил.

Конкретный код, который не работает:

Worksheets("Ops1").Range("F:AE,AG:AQ,AS:CP,CW:EF").EntireColumn.Hidden = True
                 Worksheets("Ops2").Range("F:AE,AG:AQ,AS:CP,CW:EF").EntireColumn.Hidden = True

И все это:

 Dim xFd As FileDialog
    Dim xFdItem As Variant
    Dim xFileName As String
    Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
    If xFd.Show = -1 Then
        xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
        xFileName = Dir(xFdItem & "*.xls*")
        Do While xFileName <> ""
            With Workbooks.Open(xFdItem & xFileName)
                 'your code here
                 Worksheets("Ops1").Range("F:AE,AG:AQ,AS:CP,CW:EF").EntireColumn.Hidden = True
                 Worksheets("Ops2").Range("F:AE,AG:AQ,AS:CP,CW:EF").EntireColumn.Hidden = True
            End With
        xFileName = Dir
        Loop
   End If

Я получаю индекс ошибки времени выполнения '9' вне диапазона .

Ответы [ 2 ]

1 голос
/ 26 мая 2019

Вы можете попробовать установить диапазон для переменной следующим образом.

Dim xFd As FileDialog
    Dim xFdItem As Variant
    Dim xFileName As String
    Dim sht1ColumnsToHide As Range
    Dim sht2ColumnsToHide As Range
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet

    Set ws1 = Worksheet("Ops1")
    Set ws2 = Worksheet("Ops2")
    Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
    If xFd.Show = -1 Then
        xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
        xFileName = Dir(xFdItem & "*.xls*")
        Do While xFileName <> ""
            With Workbooks.Open(xFdItem & xFileName)
                 'your code here
                    Set ws1 = Worksheets("Ops1")
                    Set ws2 = Worksheets("Ops2")

                 With ws1
                 Set sht1ColumnsToHide = Application.Union(.Columns("F:AE"), _
                                            .Columns("AG:AQ"), _
                                            .Columns("AS:CP"), _
                                            .Columns("CW:EF"))
                 sht1ColumnsToHide.EntireColumn.Hidden = True
                 End With

                 With ws2
                 Set sht2ColumnsToHide = Application.Union(.Columns("F:AE"), _
                                            .Columns("AG:AQ"), _
                                            .Columns("AS:CP"), _
                                            .Columns("CW:EF"))
                 sht2ColumnsToHide.EntireColumn.Hidden = True
               End With
            End With
        xFileName = Dir
        Loop
   End If
0 голосов
/ 26 мая 2019

Может быть немного лучше, но это должно сработать. Просто повторно используйте ваш код:

Dim xFd As FileDialog
Dim xFdItem As Variant
Dim xFileName As String
Dim X As Long, C As Long, lCol As Long
Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
    If xFd.Show = -1 Then
        xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
        xFileName = Dir(xFdItem & ".xls")
        Do While xFileName <> ""
            With Workbooks.Open(xFdItem & xFileName)
                'not sure if all your sheets are called OpsX, might need to change this
                For X = 1 To 2  'Loop through all the sheets
                    With .Worksheets("Ops" & X) 'Note the use of <[ . ]> (DOT) in the With statement
                        lCol = .Cells(1, .Columns.Count).End(xlToLeft).Column   'Get the last column, relative to row 1

                        For C = lCol To 1 Step -1           'Loop through all columns, starting at last one
                            Select Case C
                                Case 5 To 31 'F:AE
                                   .Cells(1, C).EntireColumn.Hidden = True
                                Case 33 To 43 'AG:AQ
                                   .Cells(1, C).EntireColumn.Hidden = True
                                Case 45 To 94 'AS:CP
                                   .Cells(1, C).EntireColumn.Hidden = True
                                Case 101 To 136 'CW:EF
                                   .Cells(1, C).EntireColumn.Hidden = True
                            End Select
                        Next C
                    End With
                Next X
            End With
        xFileName = Dir
        Loop
    End If
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...