Как перебрать несколько рабочих листов в рабочей книге с помощью пользовательской формы VBA
Просто обновил Мои данные, чтобы вы могли видеть. Это работает для 1 листа, так как я ссылаюсь на этот лист. По-прежнему трудно понять, как ссылаться на всю книгу, так что она будет искать имя во всех 31 листах. У меня также возникают проблемы с выяснением того, как перейти к следующей записи, если пациент находится там более одного раза в год. Любая помощь очень ценится.
Хорошо, у меня проблема с циклом прохождения всех рабочих листов в моей рабочей книге. Цели, которые я пытаюсь достичь.
- Поиск записи по имени пациента. После обнаружения все ячейки в этой записи будут импортированы в usrform.
- быть в состоянии редактировать любую информацию, которая мне нужна, и она будет сохранена обратно в ту же запись.
Я нашел видео на 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