Подход
Я должен был включить это в первую версию моего ответа.
Мое решение зависит от автофильтра.Сначала я предлагаю игровое решение, демонстрирующее этот подход:
- делая строки, не содержащие X в столбце B, невидимыми
- делая строки, не содержащие X в столбце D, невидимыми
- очистка автофильтра
Если этот подход подходит, я отсылаю вас к моему ответу на другой вопрос, который создает меню, чтобы пользователь мог выбрать, какой фильтр он хочет.
Если этот подходне подходит, я предлагаю второе решение, которое включает в себя копирование видимых строк, оставленных каждым фильтром, в другие таблицы.
Введение
Вы говорите «у меня ограниченный опыт написания макросов», что, как я понимаю, означает, что у вас есть некоторый опыт.Надеюсь, у меня правильный уровень объяснений.При необходимости возвращайтесь с вопросами.
Я предполагаю, что ваша рабочая книга находится на сервере.Я предполагаю, что у кого-то есть права на запись для обновления главной рабочей таблицы, в то время как другие открывают копии только для чтения, чтобы они могли просматривать интересующие их подмножества.Если мои предположения верны, возьмите копию рабочей тетради, с которой вы сможете поиграть.Не беспокойтесь о том, что другие обновят основную версию рабочей книги, мы завершим окончательную версию кода из вашей игровой версии, когда закончим.
Шаг 1
Скопируйте первый блок кода в модуль в версии воспроизведения.Около дна вы найдете Const WShtMastName As String = "SubSheetSrc".Замените SubSheetSrc на имя вашего основного рабочего листа.
Примечание. Макросы в этом блоке имеют имена CtrlCreateSubSheetB и CreateSubSheetB, поскольку они являются играющими версиями.Реальные версии имеют имена CtrlCreateSubSheet и CreateSubSheet.
Запуск макроса CtrlCreateSubSheetB.Вы увидите мастер-лист, но только те строки с «X» в столбце B. Нажмите на окно сообщения. Вы увидите мастер-лист, но только те строки с «X» в столбце D. Нажмите на окно сообщения ифильтр исчезнет.Переключитесь на VB Editor, если вы еще не там.В «Немедленном окне» (нажмите Ctrl + G, если его не видно), и вы увидите что-то вроде:
Rows with X in column 2: $A$1:$G$2,$A$4:$G$5,$A$8:$G$9,$A$11:$G$12,$A$14:$G$14, ...
Rows with X in column 4: $A$1:$G$1,$A$3:$G$3,$A$5:$G$5,$A$7:$G$7,$A$10:$G$10, ...
Теперь работайте с макросами CtrlCreateSubSheetB и CreateSubSheetB.Вы должны понимать, как эти макросы создали эффекты, которые вы видели.При необходимости используйте VB Help, Debugger и F8, чтобы отключить макросы, чтобы определить, что делает каждый оператор.Я полагаю, что предоставил вам достаточно информации, но при необходимости вернусь с вопросами.
' Option Explicit means I have to declare every variable. It stops
' spelling mistakes being taken as declarations of new variables.
Option Explicit
' Specify a subroutine with two parameters
Sub CreateSubSheetB(ByVal WShtSrcName As String, ByVal ColSrc As Long)
' This macro applies an AutoFilter based on column ColSrc
' to the worksheet named WShtSrcName
Dim RngVis As Range
With Sheets(WShtSrcName)
If .AutoFilterMode Then
' AutoFilter is on. Cancel current selection before applying
' new one because criteria are additive.
.AutoFilterMode = False
End If
' Make all rows which do not have an X in column ColSrc invisible
.Cells.AutoFilter Field:=ColSrc, Criteria1:="X"
' Set the range RngVis to the union of all visible rows
Set RngVis = .AutoFilter.Range.SpecialCells(xlCellTypeVisible)
End With
' Output a string to the Immediate window.
Debug.Print "Rows with X in column " & ColSrc & ": " & RngVis.Address
End Sub
' A macro to call CreateSubSheetB for different columns
Sub CtrlCreateSubSheetB()
Const WShtMastName As String = "SubSheetSrc"
Dim WShtOrigName As String
' Save the active worksheet
WShtOrigName = ActiveSheet.Name
' Make the master sheet active if it is not already active so
' you can see the different filtered as they are created.
If WShtOrigName <> WShtMastName Then
Sheets(WShtMastName).Activate
End If
' Call CreateSubSheet for column 2 (=B) then column 4 (=D)
Call CreateSubSheetB(WShtMastName, 2)
Call MsgBox("Click to continue", vbOKOnly)
Call CreateSubSheetB(WShtMastName, 4)
Call MsgBox("Click to continue", vbOKOnly)
With Sheets(WShtMastName)
If .AutoFilterMode Then
.AutoFilterMode = False
End If
End With
' Restore the original worksheet if necessary
If WShtOrigName <> WShtMastName Then
Sheets(WShtOrigName).Activate
End If
End Sub
Шаг 2
Если мои предположения о том, как вы используете книгу, вернывам может не понадобиться намного больше.Если Джон и Мэри откроют открытую для чтения копию главной рабочей книги, тогда Джон сможет использовать фильтр B, а Мэри - фильтр D.Если это звучит интересно, посмотрите на мой ответ скопировать данные строки с одного листа на один или несколько листов на основе значений в других ячейках .
Шаг 3
Если вам не нравится идея использования фильтров и вы все еще хотите создавать копии данных B и данных D, вам понадобится приведенный ниже код.
Макросы в этом блоке называютсяCtrlCreateSubSheet и CreateSubSheet, но не сильно отличаются от версий B, указанных выше.
В CtrlCreateSubSheet вам необходимо заменить «SubSheetSrc», «SubSheetB» и «SubSheetD» на ваши имена для этих рабочих листов.,Добавьте дополнительные вызовы CreateSubSheet для любых дополнительных контрольных столбцов.
Примечание: эти версии удаляют исходное содержимое листов назначения, хотя это не то, что вы просили.Я удалил исходное содержимое, потому что (1) то, что вы добавляете новые строки, является более сложным и (2) я не верю, что вы правы.Если какое-то значение имеет то, что вы просили, вернитесь, и я обновлю код.
Option Explicit
Sub CtrlCreateSubSheet()
Const WShtMastName As String = "SubSheetSrc"
' Call CreateSubSheet for column 2 (=B) then column 4 (=D)
Application.ScreenUpdating = False
Call CreateSubSheet(WShtMastName, 2, "SubSheetB")
Call CreateSubSheet(WShtMastName, 4, "SubSheetD")
With Sheets(WShtMastName)
If .AutoFilterMode Then
.AutoFilterMode = False
End If
End With
Application.ScreenUpdating = True
End Sub
Sub CreateSubSheet(ByVal WShtSrcName As String, ByVal ColSrc As Long, _
ByVal WShtDestName As String)
' This macro applies an AutoFilter based on column ColSrc to the worksheet
' named WShtSrcName. It then copies the visible rows to the worksheet
' named WShtDestName
Dim RngVis As Range
Dim WShtOrigName As String
With Sheets(WShtSrcName)
If .AutoFilterMode Then
' AutoFilter is on. Cancel current selection before applying
' new one because criteria are additive.
.AutoFilterMode = False
End If
' Make all rows which do not have an X in column ColSrc invisible
.Cells.AutoFilter Field:=ColSrc, Criteria1:="X"
' Set the range RngVis to the union of all visible cells
Set RngVis = .AutoFilter.Range.SpecialCells(xlCellTypeVisible)
End With
If RngVis Is Nothing Then
' There are no visible rows. Since the header row will be visible even if
' there are no Xs in column ColSrc, I do not believe this block can
' be reached but better to be safe than sorry.
Call MsgBox("There are no rows with an X in column " & ColSrc, vbOKOnly)
Exit Sub
End If
' Copy visible rows to worksheet named WShtDestName
With Sheets(WShtDestName)
' First clear current contents of worksheet named WShtDestName
.Cells.EntireRow.Delete
' Copy column widths to destination sheets
Sheets(WShtSrcName).Rows(1).Copy
.Rows(1).PasteSpecial Paste:=xlPasteColumnWidths
' I do not recall using SpecialPaste column widths before and it did not
' work as I expected. Hunting around the internet I found a link to a
' Microsoft page which gives a workaround. This workaround worked in
' that it copied the column widths but it left row 1 selected. I have
' added the following code partly because I like using FreezePanes and
' partly to unselect row 1.
WShtOrigName = ActiveSheet.Name
If WShtOrigName <> WShtDestName Then
.Activate
End If
.Range("A2").Select
ActiveWindow.FreezePanes = True
If WShtOrigName <> WShtDestName Then
Sheets(WShtOrigName).Activate
End If
' Copy all the visible rows in the Master sheet to the destination sheet.
RngVis.Copy Destination:=.Range("A1")
End With
End Sub
Шаг 4
После того, как вы удалили макросы по своему усмотрению, вам необходимо скопировать модуль, содержащий макросы, из вашей игровой версии в основную версию. Вы можете экспортировать модуль и затем импортировать его, но я думаю, что следующее проще:
- Откройте как рабочую, так и основную версии рабочей книги.
- Создайте пустой модуль в основной версии для хранения макросов.
- Выберите макросы в версии воспроизведения, скопируйте их в блокнот и вставьте их в пустой модуль в основной версии.
Вам нужно будет научить того, кто отвечает за обновление мастер-версии, запускать макросы при завершении значительного обновления. Вы можете использовать сочетание клавиш или добавить макрос на панель инструментов, чтобы упростить использование макроса.
Резюме
Надеюсь, все это имеет смысл. Задавайте вопросы, если это необходимо.