Таблица Excel для ввода данных в другую базу данных листов

Question

Итак, я создал лист с текстовыми полями и кнопкой. цель состоит в том, чтобы ввести информацию в соответствующие текстовые поля, и они заполняют базу данных, которая находится на другом листе. Мне удалось создать код, который работает, но есть небольшая проблема. каждый раз, когда я нажимаю кнопку, это заставляет экран мерцать, пока он копирует данные. Он работает, но мне интересно, может ли кто-нибудь увидеть способ остановить мерцание экрана. Я думаю, что это происходит, когда данные копируются из каждого текстового поля. Одно текстовое поле для одного мерцания или что-то подобное. Пытался написать цикл, но не мог понять, как получить различные текстовые поля, которые нужно перебрать.

Код, используемый ниже:

Private Sub CommandButton1_Click() 

Dim ws As Worksheet 
Set ws = Sheets("database") 

ActiveWorkbook.Sheets("database").Activate 
ws.Range("A1").Select 


    Do 
     If IsEmpty(ActiveCell) = False Then 
     ActiveCell.Offset(1, 0).Select 
     End If 
     Loop Until IsEmpty(ActiveCell) = True 

    ActiveCell.Value = TextBox1.Value 

ActiveWorkbook.Sheets("database").Activate 
ws.Range("B1").Select 


    Do 
     If IsEmpty(ActiveCell) = False Then 
     ActiveCell.Offset(1, 0).Select 
     End If 
     Loop Until IsEmpty(ActiveCell) = True 

    ActiveCell.Value = TextBox2.Value 

ActiveWorkbook.Sheets("database").Activate 
ws.Range("C1").Select 


    Do 
     If IsEmpty(ActiveCell) = False Then 
     ActiveCell.Offset(1, 0).Select 
     End If 
     Loop Until IsEmpty(ActiveCell) = True 

    ActiveCell.Value = TextBox3.Value 

ActiveWorkbook.Sheets("database").Activate 
ws.Range("D1").Select 


    Do 
     If IsEmpty(ActiveCell) = False Then 
     ActiveCell.Offset(1, 0).Select 
     End If 
     Loop Until IsEmpty(ActiveCell) = True 

    ActiveCell.Value = TextBox4.Value 

ActiveWorkbook.Sheets("database").Activate 
ws.Range("E1").Select 


    Do 
     If IsEmpty(ActiveCell) = False Then 
     ActiveCell.Offset(1, 0).Select 
     End If 
     Loop Until IsEmpty(ActiveCell) = True 

    ActiveCell.Value = TextBox5.Value 

ActiveWorkbook.Sheets("database").Activate 
ws.Range("F1").Select 


    Do 
     If IsEmpty(ActiveCell) = False Then 
     ActiveCell.Offset(1, 0).Select 
     End If 
     Loop Until IsEmpty(ActiveCell) = True 

    ActiveCell.Value = TextBox6.Value 

ActiveWorkbook.Sheets("database").Activate 
ws.Range("G1").Select 


    Do 
     If IsEmpty(ActiveCell) = False Then 
     ActiveCell.Offset(1, 0).Select 
     End If 
     Loop Until IsEmpty(ActiveCell) = True 

    ActiveCell.Value = TextBox7.Value 


End Sub 

Answer 1

Комментарий по MRig помешают мерцающий вы упоминаете, но вы можете рассмотреть вопрос просто не используя .Select и ActiveCell заявления. Они могут быть ненадежными и медленными.

Private Sub CommandButton1_Click() 

Dim ws As Worksheet 
Set ws = ThisWorkbook.WorkSheets("database") 
Dim lastRow 
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row ' gets last row in A 
ws.Range("A" & lastRow + 1).Value = TextBox1.Value 

lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row ' gets last row in B 
ws.Range("B" & lastRow + 1).Value = TextBox2.Value 
' ... and so on until 

lastRow = ws.Cells(ws.Rows.Count, "G").End(xlUp).Row ' gets last row in G 
ws.Range("G" & lastRow + 1).Value = TextBox7.Value 

End Sub 

Это позволит сохранить все зацикливание и выбор вы делаете так, что это будет намного быстрее, и действительно ли не включать вас в Application.ScreenUpdating экран не будет мерцать на всех.

Answer 2

отредактирован добавить решения для текстовых элементов ActiveX

данных фактических Textboxes имен и диапазоны для заполнения значений с, вы могли бы просто идти, как это:

---

Решения для рабочего листа «ActiveX» текстовые поля (код находится на панели ввода базы данных)

Option Explicit 

Private Sub CommandButton1_Click() 
    Dim iTB As Long 

    For iTB = 1 To 7 '<--| just change "7" to your actual numebre of textboxes 
     Cells(Rows.Count, Range("A1").Offset(, iTB - 1)).End(xlUp).Offset(1).Value = OLEObjects("TextBox" & iTB).Object.Value 
    Next iTB 
End Sub 

---

Раствор для UserForm текстовых полей (код идет в панели UserForm коды)

Option Explicit 

Private Sub CommandButton1_Click() 
    Dim iTB As Long 

    With ThisWorkbook.Worksheets("database") 
     For iTB = 1 To 7 '<--| just change "7" to your actual number of textboxes 
      .Cells(.Rows.Count, .Range("A1").Offset(, iTB - 1)).End(xlUp).Offset(1).Value = Me.Controls("TextBox" & iTB).Value 
     Next iTB 
    End With  
End Sub