Это длинный и несколько сложный ответ, который затрагивает все аспекты вашего вопроса. Вам потребуется добавить код в вашу рабочую книгу. Я сделаю все возможное, чтобы провести вас через это.
Отказ от ответственности: используйте это на свой страх и риск.Перед началом работы рекомендуется создать резервную копию файла. Сохраняйте свою работу часто. Это было проверено в Excel 2010 на основе предоставленной информации и просто для того, чтобы помочь вам. Может потребоваться настроить его в соответствии с вашими потребностями.
Во-первых, вам нужно добавить следующий код в модуль в проводнике VBA. Это можно открыть, нажав Alt+F11. На левой панели разверните папку module . Если там нет модуля, добавьте его, щелкнув правой кнопкой мыши и выбрав Insert затем Module . Дважды щелкните модуль, который вы только что создали.
Теперь на правой панели вставьте следующий код. Этот код берет значения из столбцов и помещает их в ячейку, разделенную комой. Код кредита - Microsoft MVPs McGimpsey & Associates.
'*****************************************
'Purpose: Concatenate all cells in a range
'Inputs: rRng - range to be concatenated
' sDelimiter - optional delimiter
' to insert between cell Texts
'Returns: concatenated string
'*****************************************
Public Function MultiCat( _
ByRef rRng As Excel.Range, _
Optional ByVal sDelim As String = "") _
As String
Dim rCell As Range
For Each rCell In rRng
If rCell.Text <> "" Then
MultiCat = MultiCat & sDelim & rCell.Text
End If
Next rCell
MultiCat = Mid(MultiCat, Len(sDelim) + 1)
End Function
Sub CopyRanges()
'Copy Months
Sheets("groups").Range("H2").Copy
Sheets("UserAccess").Range("D3").End(xlDown).Offset(1, 0).PasteSpecial Paste:=xlValues
'Copy Fruit
Sheets("groups").Range("H3").Copy
Sheets("UserAccess").Range("E3").End(xlDown).Offset(1, 0).PasteSpecial Paste:=xlValues
'Copy Color
Sheets("groups").Range("H4").Copy
Sheets("UserAccess").Range("F3").End(xlDown).Offset(1, 0).PasteSpecial Paste:=xlValues
'Copy Music
Sheets("groups").Range("H5").Copy
Sheets("UserAccess").Range("G3").End(xlDown).Offset(1, 0).PasteSpecial Paste:=xlValues
'Reset check boxes
Dim ChkBox As Object
Dim Wks As Worksheet
For Each Wks In Worksheets
For Each ChkBox In Wks.CheckBoxes
ChkBox.Value = xlOff
Next ChkBox
Next Wks
End Sub
Теперь на листе groups добавьте эти формулы в ячейки H2, H3, H4 и H5 соответственно. Это то, что читает значения флажка и помещает их в одну ячейку.
=MultiCat(C2:C13,", ")
=MultiCat(F2:F6,", ")
=MultiCat(F8:F10,", ")
=MultiCat(F12:F15,", ")
Вы должны быть в состоянии проверить это, установив флажки. Это должно прочитать значения столбцов C и F затем поместить их в ячейки, в которые вы только что скопировали формулы.
Если ячейки не обновляются при установке флажков, вам необходимо установить Options > Workbook Calculations > Auto Calculate . Не беспокойтесь о формате столбца, потому что он пока заполнитель и будет скрыт позже.
Добавьте кнопку на лист groups . Если вы не знаете, как это сделать, следуйте этим инструкциям (используйте кнопку «Добавить кнопку» (элемент управления «Форма»)) - добавьте кнопку и назначьте ей макрос на рабочем листе . Когда он запрашивает макрос для назначения, выберите CopyRanges . Щелкните правой кнопкой мыши по кнопке и выберите « Edit Text в соответствии с вашими пожеланиями.
Отмените выбор Design Mode на ленте разработчика.
Выберите несколько полей и нажмите кнопку, чтобы попробовать. Когда это будет сделано, он должен был скопировать данные из столбца H в следующую пустую строку на другом листе, а затем снять флажки для следующей записи.
Как только он заработает, скройте столбцы C , F & H Excel 2010 потребует от вас сохранить его как книгу с поддержкой Macro Enabled чтобы все работало правильно.
