Перемещение записей между листами при обновлении значения формы ввода - PullRequest
0 голосов
/ 19 июня 2019

Я не могу понять, как вырезать и вставлять записи между двумя рабочими листами, когда значение из формы ввода изменяется с «Открытый проект» на «Закрытый проект».

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

Option explicit    
Private Sub CommandButton1_Click()

 'Searches for record, and cuts/ pastes records into Project Log when Project Status is set to Closed

Dim ab As Worksheet
Dim aa As Worksheet
  Set ab = ThisWorkbook.Sheets("Open Projects No SLA - Log")
  Set aa = ThisWorkbook.Sheets("Project Log")
  Dim q As Long
  Dim m As Long

    If Me.proj_stat_combo.Value = "OPEN PROJECTS (No Current Open SLA)" Then
       q = Application.Match(VBA.CLng(Me.srnew_combo.Value), ab.Range("C:C"), 0)
       m = ab.Range("C" & Application.Rows.Count).End(xlUp).Row        

    Worksheets("Open Projects No SLA - Log").Range(1).Cut Worksheets("Project Log").Range(m + 1)

  End If

В надежде получить записи из «Open Projects No SLA - Log», которые будут вырезаны из рабочего листа и вставлены в «Project Log» рабочий лист », когда данные формы ввода для статуса проекта изменилисьот "ОТКРЫТЫХ ПРОЕКТОВ (без текущего открытого SLA)" до закрытых.

1 Ответ

0 голосов
/ 19 июня 2019

Попробуйте что-то вроде этого:

Option explicit    

Private Sub CommandButton1_Click()

 'Searches for record, and cuts/ pastes records into Project Log 
 '     when Project Status is set to Closed

    Dim ab As Worksheet, q As variant, m As Long
    Dim aa As Worksheet

    Set ab = ThisWorkbook.Sheets("Open Projects No SLA - Log")
    Set aa = ThisWorkbook.Sheets("Project Log")

    If Me.proj_stat_combo.Value = "OPEN PROJECTS (No Current Open SLA)" Then

       q = Application.Match(VBA.CLng(Me.srnew_combo.Value), ab.Range("C:C"), 0)
       'check we got a match
       If not iserror(q) then
           'adjust next line to fit your # of columns and exact paste destination...
           ab.Cells(q,"A").Resize(1,30).cut aa.Cells(rows.count,"C").End(xlUp).Offset(1,0)
       Else
           Msgbox "No match for project id!"
       End if


  End If
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...