VBA Скрытие столбцов и строк с использованием ячеек - PullRequest
0 голосов
/ 20 февраля 2020

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

Кроме того, если ссылочная ячейка / диапазон пуста, то я хотел бы продолжить код без скрытия каких-либо строк или столбцов.

Скрываемые столбцы: на основе ячеек C8: D8

Ряды для скрытия: на основе ячеек C9: D9

Здесь находится Логический праздник должен состояться



reportColumnsAddr = settingsSheet.Range("C8").Value & ":" & settingsSheet.Range("D8").Value

reportRowsAddr = settingsSheet.Range("C9").Value & ":" & settingsSheet.Range("D9").Value

Текущий код

Option Explicit

Private Sub CommandButton1_Click()


Dim MyFolder As String, MyFile As String
Dim StartTime As Double
Dim MinutesElapsed As String
Dim Filename As String
Dim Cell As String
Dim Counter As Long


If ThisWorkbook.Sheets("Sheet1").Range("C7").Value = vbNullString Then

MsgBox "Enter Tab Name"
Exit Sub

End If

With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
.Title = "Select a Folder"
If .Show = True Then
MyFolder = .SelectedItems(1)

End If



If .SelectedItems.Count = 0 Then Exit Sub
Err.Clear
End With


Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

MyFile = Dir(MyFolder & "\", vbReadOnly)

StartTime = Timer

Do While MyFile <> ""
DoEvents
On Error GoTo 0

Workbooks.Open Filename:=MyFolder & "\" & MyFile, UpdateLinks:=False


Dim settingsSheet As Worksheet 'Source
Dim reportSheet As Worksheet 'To convert to PDF
 Dim targetColumnsRange As Range 'feeds from source
Dim targetRowsRange As Range
Dim reportSheetName As String 'source sheet with the target's sheet name
Dim reportColumnsAddr As String
Dim reportRowsAddr As String
' Set a reference to the settings sheet

Set settingsSheet = ThisWorkbook.Worksheets("Sheet1") ' source

' Gather the report sheet's name

reportSheetName = settingsSheet.Range("C7").Value ' good

reportColumnsAddr = settingsSheet.Range("C8").Value & ":" & settingsSheet.Range("D8").Value

reportRowsAddr = settingsSheet.Range("C9").Value & ":" & settingsSheet.Range("D9").Value

Set reportSheet = Sheets(reportSheetName) 

Set targetColumnsRange = reportSheet.Range(reportColumnsAddr)

Set targetRowsRange = reportSheet.Range(reportRowsAddr)

targetColumnsRange.EntireColumn.Hidden = True
targetRowsRange.EntireRow.Hidden = True


With reportSheet.PageSetup
.Zoom = False
.FitToPagesWide = 1 '.FitToPagesTall = 1
End With

Filename = ActiveWorkbook.Name

Cell = Replace(Filename, ".xlsx", ".PDF")

reportSheet.Select
reportSheet.PageSetup.Orientation = xlLandscape

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _

ThisWorkbook.Path & "\" & Cell, _

Quality:=xlQualityStandard, IncludeDocProperties:=True, _

IgnorePrintAreas:=True, OpenAfterPublish:=False

Counter = Counter + 1

0

Workbooks(MyFile).Close SaveChanges:=False

MyFile = Dir

Loop

'turns settings back on


Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.EnableEvents = True
Application.Calculation = xlCalculationManual

MinutesElapsed = Format((Timer - StartTime) / 86400, "hh:mm:ss")

MsgBox "Successfully Converted " & Counter & " Files in " & MinutesElapsed & " minutes", vbInformation

End Sub

Ответы [ 2 ]

1 голос
/ 20 февраля 2020

Несколько мыслей о вашем коде:

Dim MySheet As String

  1. Как mySheet относится к имени листа, проясните это.

    Переименуйте переменную в Dim mySheetName as String


Set ReportSheet = Sheets (MySheet)

При задании ссылки на лист отчета используйте полный квилинг к объекту.

Добавьте Set reportSheet = ThisWorkbook.Worksheets(mySheetName)


I попытался использовать следующую логику c, но она не сработала, поскольку я не могу вставить "как часть именования, чтобы правильно создать мою переменную.

Чтобы вставить символ двойной кавычки, вы можете использовать: char(34)

например TEST1 = "(" & Chr(34) & ThisWorkbook.Sheets("Sheet1").Range("C8").Value & ThisWorkbook.Sheets("Sheet1").Range("D8").Value & Chr(34) & ")"


Теперь о запрос:

Вы можете сделать это более коротким способом, но я выбрал этот более длинный путь, чтобы проиллюстрировать идею.

  1. Соберите информацию о настройках
  2. Установить ссылку на столбцы и строки
  3. Найти пересечение между ними
  4. Искать непустые ячейки в этом диапазоне и скрывать их столбцы и строки

Код:

Public Sub DynamicallyHideCells()

    Dim settingsSheet As Worksheet
    Dim reportSheet As Worksheet

    Dim targetColumnsRange As Range
    Dim targetRowsRange As Range
    Dim targetRange As Range
    Dim targetCell As Range

    Dim reportSheetName As String
    Dim reportColumnsAddr As String
    Dim reportRowsAddr As String

    ' Set a reference to the settings sheet
    Set settingsSheet = ThisWorkbook.Worksheets("Sheet1")

    ' Gather the report sheet's name
    reportSheetName = settingsSheet.Range("C7").Value

    ' Check the : between the two cells reference
    reportColumnsAddr = settingsSheet.Range("C8").Value & ":" & settingsSheet.Range("D8").Value

    ' Check the : between the two cells reference
    reportRowsAddr = settingsSheet.Range("C9").Value & ":" & settingsSheet.Range("D9").Value

    ' Set a reference to the report's sheet
    Set reportSheet = ThisWorkbook.Worksheets(reportSheetName)

    ' Set a reference to the report's columns
    Set targetColumnsRange = reportSheet.Range(reportColumnsAddr)

    ' Set a reference to the report's rows
    Set targetRowsRange = reportSheet.Range(reportRowsAddr)

    ' Find the range of cells to be evaluated
    Set targetRange = Intersect(targetColumnsRange, targetRowsRange)

    ' Loop through each cell and hide if not empty
    For Each targetCell In targetRange.Cells

        If targetCell.Value <> vbNullString Then
            targetCell.EntireColumn.Hidden = True
            targetCell.EntireRow.Hidden = True
        End If

    Next targetCell


End Sub

РЕДАКТИРОВАТЬ:

Если вам нужно только скрыть столбцы. Используйте следующий код:

РЕДАКТИРОВАТЬ 2:

Добавлена ​​строка, чтобы проверить, являются ли входные ячейки пустыми ('Проверьте, пуста ли какая-либо из ячеек и выйдите из подпрограммы).

Public Sub HideColumns()

    Dim settingsSheet As Worksheet
    Dim reportSheet As Worksheet

    Dim targetColumnsRange As Range

    Dim reportSheetName As String
    Dim reportColumnsAddr As String

    ' Set a reference to the settings sheet
    Set settingsSheet = ThisWorkbook.Worksheets("Sheet1")

    ' Gather the report sheet's name
    reportSheetName = settingsSheet.Range("C7").Value

    ' Check the : between the two cells reference
    reportColumnsAddr = settingsSheet.Range("C8").Value & ":" & settingsSheet.Range("D8").Value

    ' Check if either cell are empty and exit sub
    If settingsSheet.Range("C8").Value = vbNullString Or settingsSheet.Range("D8").Value = vbNullString Then

        ' Set a reference to the report's sheet
        Set reportSheet = ThisWorkbook.Worksheets(reportSheetName)

        ' Set a reference to the report's columns
        Set targetColumnsRange = reportSheet.Range(reportColumnsAddr)

        ' Hide the columns in range
        targetColumnsRange.EntireColumn.Hidden = True


    Else

        ' Do something here

    End If


End Sub

Надеюсь, это то, что вы ищете.

Дайте мне знать, если это работает.

0 голосов
/ 20 февраля 2020

Заменить "" на "" "":

TEST1 = "(" & """" & ThisWorkbook.Sheets("Sheet1").Range("C8").Value & ThisWorkbook.Sheets("Sheet1")
.Range("D8").Value & """" & ")"
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...