Как перебрать несколько рабочих листов в рабочей книге с помощью пользовательской формы VBA

Просто обновил Мои данные, чтобы вы могли видеть. Это работает для 1 листа, так как я ссылаюсь на этот лист. По-прежнему трудно понять, как ссылаться на всю книгу, так что она будет искать имя во всех 31 листах. У меня также возникают проблемы с выяснением того, как перейти к следующей записи, если пациент находится там более одного раза в год. Любая помощь очень ценится.

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

  1. Поиск записи по имени пациента. После обнаружения все ячейки в этой записи будут импортированы в usrform.
  2. быть в состоянии редактировать любую информацию, которая мне нужна, и она будет сохранена обратно в ту же запись.

Я нашел видео на Youtube о том, как это сделать, с помощью листа, но не всей книги. Также этот код будет использоваться в существующей форме пользователя. Для этого потребуется функция, которая позволит мне выбрать следующий раз, когда появится пациент. Таким образом, может быть несколько записей этого пациента. Хотел бы иметь возможность выбрать год и пациента в качестве критериев для поиска.

      Private Sub CommandButton1_Click()
Dim ws As Worksheet
Dim found As Range
row_number = 0
Do
DoEvents
row_number = row_number + 1
item_in_review = Sheets("2012").Range("A" & row_number)

        If item_in_review = Patients_Name.Text Then
            Date_of_Incident.Text = Sheets("2012").Range("B" & row_number)
            Month.Text = Sheets("2012").Range("C" & row_number)
            Year.Text = Sheets("2012").Range("D" & row_number)
        End If

Loop Until item_in_review = ""

End Sub

1 ответ

Решение

Чтобы просмотреть все рабочие листы в рабочей книге

Option Explicit
Dim ws As Worksheet

For Each ws in ThisWorkbook.Sheets
    '' do stuff with ws here
Next ws

Есть также несколько вещей, которые вы можете улучшить в своем коде...

Sub TestStuff()

Dim ws              As Worksheet
Dim rng             As Range
Dim found           As Range
Dim firstAddress    As String

For Each ws In ThisWorkbook.Sheets
    '' set the range you want to search in
    Set rng = ws.Range("D1:D" & ws.Range("D" & ws.Rows.Count).End(xlUp).Row)
    '' see if it contain's the patient's name (can make this case insensitive)
    Set found = rng.Find("Patient's Name Here", SearchDirection:=xlNext)

    '' if it found something
    If Not found Is Nothing Then
        firstAddress = found.address
        '' loop until we hit the first cell again
        Do
            '' set textbox values
            Date_Of_Incident.Text = found.Offset(,-3).Value
            Month_Of_Incident.Text = found.Offset(,-2).Value
            Year_Of_Incident.Text = found.Offset(,-1).Value

            Set found = rng.Find("Patient's Name Here", SearchDirection:=xlNext, After:=found)
        Loop While Not found Is Nothing And found.address <> firstAddress
    End If

Next ws

End Sub

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

Если вы хотите получить мои два цента, я бы использовал ListBox, в котором указана дата всех встреч, которые имеет пациент, таким образом, вы можете увидеть: "О, у этого пользователя было 4 встречи, и я хочу посмотреть на это. " Затем вы нажимаете на нужную запись ListBox, и в ней хранится некоторая информация о том, что эта запись ListBox соответствует этой записи на рабочем листе. Затем он извлекает эту информацию из рабочего листа и заполняет пользовательскую форму. Опять же, только мои два цента, основанные на том, что я прочитал.


После обсуждения в чате окончательный код был таким:

Option Explicit
Private Sub AddWithValue(Text As String, Value As String)

    lbxAppointments.AddItem Text
    lbxAppointments.List(lbxAppointments.ListCount - 1, 1) = Value

End Sub


Private Sub btnSearch_Click()

    Dim ws          As Worksheet
    Dim search      As Range
    Dim found       As Range
    Dim patient     As String
    Dim lbxValue    As String
    Dim firstFind   As String

    lbxAppointments.Clear

    patient = tbxPatientName.Text

    For Each ws In ThisWorkbook.Sheets
        '' define our search range (Column A)
        Set search = ws.Range("A1:A" & ws.Range("A" & ws.Rows.Count).End(xlUp).Row)
        '' search that range for the patient's name
        Set found = search.Find(patient, SearchDirection:=xlNext)

        '' test if we found anything
        If Not found Is Nothing Then
            firstFind = found.Address

            Do
                '' found something, add it to the text box
                lbxValue = "'" & found.Parent.Name & "'!" & found.Address(External:=False)
                AddWithValue found.Offset(, 1).Value, lbxValue

                Set found = search.Find(patient, SearchDirection:=xlNext, After:=found)
            Loop While Not found Is Nothing And found.Address <> firstFind
        End If
    Next ws

End Sub

Private Sub lbxAppointments_Change()

    Dim rng     As Range

    With lbxAppointments
        If .ListIndex <> -1 Then
            Set rng = Range(.List(.ListIndex, 1))
            '' now get all of the offsets of it here and you can populate textbox controls with the info
            '' rng.Offset(,1) = Column B
            '' rng.Offset(,2) = Column C
            '' rng.Offset(,3) = Column D, so on and so forth
        End If
    End With

End Sub
Другие вопросы по тегам