У меня есть следующая проблема:

Я должен выполнять какое-то задание несколько раз в год, а номера недель, в которых я должен выполнять эти задания, находятся рядом с объединенной ячейкой, в которой находится задание. Теперь я хотел бы найти эти номера недели в поисках задачи.

Ниже приведены данные, с которыми я столкнулся. В первом столбце находятся объединенные ячейки, а в третьем столбце - номера недели.

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

2 ответа2

1

Вы не просили решение VBA, но, казалось бы, его проще всего реализовать. Вы также не указали, каким образом вы хотите, чтобы ваши данные выводились, или как вы хотели иметь возможность выбрать задачу / недели для отображения.

Я предположил или выбрал следующее, все из которых можно изменить:

  • Задачи и недели будут в столбцах А и С, как показано выше.
  • Соответствующая задача будет выбрана из выпадающего списка, реализована путем проверки данных, и этот список задач будет отсортирован по алфавиту (отсортирован).
  • Поскольку ваш список задач включает запятые, нам нужно создать список задач в виде диапазона ячеек на листе. Этот лист будет скрытым листом.
  • Список будет выведен в окне сообщения
  • Алгоритм позволяет дублировать задачи в столбце A
  • Список возвращаемых недель критически зависит от объединенной области списка задач. Если вы когда-нибудь откроете ячейки, алгоритм нужно будет скорректировать.
  • Список будет обновляться всякий раз, когда вы вносите изменения в список задач или изменяете выбранную задачу в раскрывающемся списке.

Код рабочего листа

Щелкните правой кнопкой мыши вкладку «Рабочий лист» и выберите « View Code


Option Explicit
Private Sub Worksheet_Activate()
    Set rInput = Cells(1, 5)
    Application.EnableEvents = False
        ValidationList
    Application.EnableEvents = True
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    Set rInput = Cells(1, 5)
    If Not Intersect(Target, Columns(1)) Is Nothing Then
        Application.EnableEvents = False
            ValidationList
        Application.EnableEvents = True
    End If
    If Not Intersect(Target, rInput) Is Nothing Then DisplayWeeks
End Sub

Обычный модуль

Выберите Insert Module в строке меню редактора VB.


Option Explicit
Public rInput As Range
Sub ValidationList()
    Dim colTasks As Collection
    Dim vTasks() As Variant
    Dim V1 As Variant, V2 As Variant
    Dim I As Long

'Read the tasks into a variant array
V1 = Range(Cells(2, 1), Cells(Rows.Count, 1).End(xlUp))

'Collect the tasks, eliminate the blanks
'Remove Duplicate entries

Set colTasks = New Collection

On Error Resume Next
For Each V2 In V1
    If V2 <> "" Then colTasks.Add V2, CStr(V2)
Next V2
On Error GoTo 0

'Read tasks into array
ReDim vTasks(1 To colTasks.Count)
For I = 1 To UBound(vTasks)
    vTasks(I) = colTasks(I)
Next I

'Since tasks might contain a comma
'  the list must be on a worksheet
'Create the worksheet if not present
'  and hide it
Dim wsTasks As Worksheet
Dim rTasks As Range

On Error Resume Next
    Set wsTasks = Worksheets("Tasks")
    Select Case Err.Number
        Case 9
            Worksheets.Add
            ActiveSheet.Name = "Tasks"
            Set wsTasks = Worksheets("Tasks")
            wsTasks.Visible = xlSheetHidden
        Case Is <> 0
            Debug.Print Err.Number, Err.Description
            Stop 'for debugging
            Exit Sub
    End Select
On Error GoTo 0

Set rTasks = wsTasks.Cells(1, 1).Resize(1, UBound(vTasks))
rTasks = vTasks

'Sort the task list
rTasks.Sort key1:=rTasks.Rows(1), _
            order1:=xlAscending, _
            Header:=xlNo, _
            MatchCase:=False, _
            Orientation:=xlSortRows

'Create the Input Cell
With rInput
    .Clear
    With .Validation
        .Add Type:=xlValidateList, _
         AlertStyle:=xlValidAlertInformation, _
         Formula1:="=" & rTasks.Worksheet.Name & "!" & rTasks.Address(True, True)
        .InCellDropdown = True
        .InputMessage = "Select from Drop Down List"
        .ShowInput = True
        .ShowError = True
    End With

    .Style = "Input"
End With

End Sub

Выберите « Insert Module в строке меню редактора VB, чтобы вставить второй обычный модуль. Вы можете поместить оба в один и тот же модуль, но отладка может быть проще

Если вы поместите оба макроса в один и тот же модуль, удалите второй экземпляр Option Explicit


Option Explicit

Sub DisplayWeeks()
    Dim colWeeks As Collection
    Dim R1 As Range, R2 As Range, C As Range
    Dim FirstAddress As String
    Dim V As Variant, I As Long

Set colWeeks = New Collection

'Find the task(s)
If rInput = "" Then Exit Sub
With Columns(1)
    Set R1 = .Find(what:=rInput, _
        after:=.Cells(.Rows.Count), _
        LookIn:=xlValues, _
        lookat:=xlWhole, _
        searchorder:=xlByRows, _
        searchdirection:=xlNext, _
        MatchCase:=False)
    If R1 Is Nothing Then
        MsgBox "Something Wrong" & vbLf & """Find"" &  did not work"
        Stop
        Exit Sub
    End If

    FirstAddress = R1.Address
    Set R2 = R1.Offset(0, 2).Resize(rowsize:=R1.MergeArea.Rows.Count)
    For Each C In R2
        If C.Text <> "" Then colWeeks.Add C.Text
    Next C

    Do
        Set R1 = .FindNext(R1)
            If R1 Is Nothing Then Exit Do
        If R1.Address <> FirstAddress Then
            Set R2 = R1.Offset(0, 2).Resize(rowsize:=R1.MergeArea.Rows.Count)
            For Each C In R2
                If C.Text <> "" Then colWeeks.Add C.Text
            Next C
        End If
    Loop Until R1.Address = FirstAddress
End With

ReDim V(1 To colWeeks.Count)
For I = 1 To UBound(V)
    V(I) = CStr(colWeeks(I))
Next I

Application.Cursor = xlDefault
MsgBox "Weeks for this task:" & vbLf & Join(V, vbLf)

End Sub
-2

Есть ли причина, по которой вы не можете использовать .Next? Например, если вы выберете одну из ячеек с задачей в ней, Selection.Next.Next.Text захватит текст ячейки на два столбца или Selection.Next.Next.Value будет захватывать значение этой ячейки. (Если вы не выбираете задачу напрямую, вы можете подать заявку .Next.Next.Text или .Next.Next.Value программно.)

Всё ещё ищете ответ? Посмотрите другие вопросы с метками .