Уточнить копию / вставить в другую рабочую книгу для нескольких критериев в том же столбце

Question

VBA, как кажется, глючит (вид экрана переходит вперед и назад) и не заканчивается обратно на пользовательской форме.Есть ли способ улучшить VBA, чтобы работать лучше?и есть ли другой способ разместить строку в определенной строке на листе?

Excel VBA - с использованием пользовательской формы и таблицы данных (рабочая книга A).После ввода числа до 8 различных текстовых полей в пользовательской форме.Текстовое поле связано с таблицей данных.VBA получает номер из таблицы данных и ищет в другой книге (Рабочая тетрадь B) номер в столбце A. После того, как он найден, он копирует и вставляет в строку на листе (рабочая тетрадь а).последовательность будет продолжаться для следующего текстового поля и следующего и т. д.

Private Sub CommandButton83_Click()
Dim LastRow As Integer, i As Integer, erow As Integer

LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To LastRow

If Cells(i, 1).Value = TextBox192.Value Then
Range(Cells(i, 1), Cells(i, 25)).Select
Selection.Copy
Workbooks.Open Filename:="C:location"

Workbooks("MainWorkBook").Worksheets("PatientData").Activate
Worksheets("PatientData").Select

ActiveSheet.Cells(3, 1).Select
ActiveSheet.Paste
ActiveWorkbook.Save
ActiveWorkbook.Close
Application.CutCopyMode = False
End If
Next i

Workbooks("Workbook2").Worksheets("Roll Call").Activate

LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To LastRow
If Cells(i, 1).Value = TextBox193.Value Then
Range(Cells(i, 1), Cells(i, 25)).Select
Selection.Copy
Workbooks.Open Filename:="C:location"

Workbooks("MainWorkBook").Worksheets("PatientData").Activate
Worksheets("PatientData").Select
ActiveSheet.Cells(5, 1).Select
ActiveSheet.Paste
ActiveWorkbook.Save
Application.CutCopyMode = False
End If
Next i


Workbooks("Workbook2").Worksheets("Roll Call").Activate

LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To LastRow
If Cells(i, 1).Value = TextBox194.Value Then
 Range(Cells(i, 1), Cells(i, 25)).Select
 Selection.Copy
 Workbooks.Open Filename:="C:location"

Workbooks("MainWorkBook").Worksheets("PatientData").Activate
 Worksheets("PatientData").Select
 ActiveSheet.Cells(7, 1).Select
 ActiveSheet.Paste
 ActiveWorkbook.Save
 Application.CutCopyMode = False
 End If
 Next i

 Workbooks("Workbook2").Worksheets("Roll Call").Activate

LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To LastRow
If Cells(i, 1).Value = TextBox195.Value Then
Range(Cells(i, 1), Cells(i, 25)).Select
Selection.Copy
Workbooks.Open Filename:="C:\location"

Workbooks("MainWorkBook").Worksheets("PatientData").Activate
Worksheets("PatientData").Select
ActiveSheet.Cells(9, 1).Select
ActiveSheet.Paste
ActiveWorkbook.Save
Application.CutCopyMode = False
End If
Next i

LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To LastRow
If Cells(i, 1).Value = TextBox196.Value Then

Range(Cells(i, 1), Cells(i, 25)).Select
Selection.Copy
Workbooks.Open Filename:="C:Location of file"

Workbooks("MainWorkBook").Worksheets("PatientData").Activate
Worksheets("PatientData").Select

ActiveSheet.Cells(11, 1).Select
ActiveSheet.Paste
ActiveWorkbook.Save
Application.CutCopyMode = False
End If
Next i

LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To LastRow
If Cells(i, 1).Value = TextBox197.Value Then
Range(Cells(i, 1), Cells(i, 25)).Select
Selection.Copy
Workbooks.Open Filename:="C:Location"

Workbooks("MainWorkBook").Worksheets("PatientData").Activate
Worksheets("PatientData").Select

ActiveSheet.Cells(13, 1).Select
ActiveSheet.Paste
 ActiveWorkbook.Save
ActiveWorkbook.Close
Application.CutCopyMode = False
End If
Next i

LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To LastRow
If Cells(i, 1).Value = TextBox198.Value Then
Range(Cells(i, 1), Cells(i, 25)).Select
Selection.Copy
Workbooks.Open Filename:="C:location"

Workbooks("MainWorkBook").Worksheets("PatientData").Activate
Worksheets("PatientData").Select

ActiveSheet.Cells(15, 1).Select
ActiveSheet.Paste
ActiveWorkbook.Save
Application.CutCopyMode = False
End If
Next i


If OptionButton65.Value = True Then
Workbooks("Workbook2").Worksheets("Roll Call").Activate

LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To LastRow
If Cells(i, 1).Value = TextBox199.Value Then
Range(Cells(i, 1), Cells(i, 25)).Select
Selection.Copy
Workbooks.Open Filename:="C:location"

Workbooks("MainWorkBook").Worksheets("PatientData").Activate
Worksheets("PatientData").Select

ActiveSheet.Cells(17, 1).Select
ActiveSheet.Paste
ActiveWorkbook.Save
Application.CutCopyMode = False
End If
Next i


End Sub

'Возможность уточнить VBA до единой функции поиска числа, указанного в текстовом поле (которое будет меняться при каждом использовании) назакройте / откройте рабочую книгу и скопируйте строку, соответствующую номеру, в рабочую книгу формы пользователя в определенной строке.За одно использование будет скопировано только восемь строк, но, скорее всего, будет использовано три.Поэтому не во все текстовые поля будут вводиться данные каждый раз.

Answer 1

Private Sub CommandButton83_Click()
Dim c As Range
Dim d As Range, u As Range, o As Range, p As Range, q As Range, r As Range, _
 s As Range
Dim j As Integer
Dim Source As Worksheet
Dim Target As Worksheet
Dim Outcome As Worksheet


Application.Workbooks.Open Filename:="C:\Users\Desktop\Workbook1.xml"

Application.ScreenUpdating = False
Set Source = Application.Workbooks("WorkBook1").Worksheets("Sheet1")
Set Target = ThisWorkbook.Worksheets("DataSheet")
Set Outcome = ThisWorkbook.Worksheets("Data")

    For Each c In Source.Range("A3:A" & Source.Cells(Rows.Count, "A").End(xlUp).Row)
        j = Outcome.Cells(Rows.Count, 3).End(xlUp).Row + 1
        If c = TextBox192.Value Then Outcome.Rows(j).Value = Source.Rows(c.Row).Value
    Next c

    For Each d In Source.Range("A1:A" & Source.Cells(Rows.Count, "A").End(xlUp).Row)
        j = Outcome.Cells(Rows.Count, 3).End(xlUp).Row + 1
        If d = TextBox193.Value Then Outcome.Rows(j).Value = Source.Rows(d.Row).Value
    Next d

    For Each n In Source.Range("A1:A" & Source.Cells(Rows.Count, "A").End(xlUp).Row)
        j = Outcome.Cells(Rows.Count, 3).End(xlUp).Row + 1
        If n = TextBox194.Value Then Outcome.Rows(j).Value = Source.Rows(n.Row).Value
    Next n

    For Each o In Source.Range("A1:A" & Source.Cells(Rows.Count, "A").End(xlUp).Row)
         j = Outcome.Cells(Rows.Count, 3).End(xlUp).Row + 1
         If o = TextBox195.Value Then Outcome.Rows(j).Value = Source.Rows _  
         (o.Row).Value
    Next o

    For Each p In Source.Range("A1:A" & Source.Cells(Rows.Count, "A").End(xlUp).Row)
         j = Outcome.Cells(Rows.Count, 3).End(xlUp).Row + 1
         If p = TextBox196.Value Then Outcome.Rows(j).Value = Source.Rows _   
         (p.Row).Value
     Next p

    For Each q In Source.Range("A1:A" & Source.Cells(Rows.Count, "A").End(xlUp).Row)
          j = Outcome.Cells(Rows.Count, 3).End(xlUp).Row + 1
         If q = TextBox197.Value Then Outcome.Rows(j).Value = Source.Rows _
         (q.Row).Value
    Next q

     For Each r In Source.Range("A1:A" & Source.Cells(Rows.Count, "A").End(xlUp).Row)
         j = Outcome.Cells(Rows.Count, 3).End(xlUp).Row + 1
         If r = TextBox198.Value Then Outcome.Rows(j).Value = Source.Rows _
         (r.Row).Value
     Next r

     For Each s In Source.Range("A1:A" & Source.Cells(Rows.Count, "A").End(xlUp).Row)
          j = Outcome.Cells(Rows.Count, 3).End(xlUp).Row + 1
         If s = TextBox199.Value Then Outcome.Rows(j).Value = Source.Rows _  
         (s.Row).Value
     Next s

    Application.ScreenUpdating = True

    Workbooks("WorkBook1").Close

    MsgBox "done!"

End Sub

Answer 2

VBA выглядит сбойно (вид экрана переходит вперед и назад)

Непосредственный ответ на устранение «сбойного» поведения состоит в том, чтобы избегать использования Select и Activate.Например:

• Как избежать использования Select в Excel VBA
• Excel 2013 VBA, альтернативный использованию Activate и Select

Кроме того, правильное выделение кода помогает в удобочитаемости, обслуживании и поиске ошибок.

Наконец.Добавьте Option Explicit в начало модуля, содержащего код. Всегда .