输入表单值更新时在工作表之间移动记录

时间:2019-06-19 19:06:38

标签: excel vba excel-vba

当输入表单中的值从“打开的项目”更改为“关闭的项目”时,我无法弄清楚如何在两个工作表之间剪切和粘贴记录。

这是我正在创建的项目管理数据库,目的是减少花费在添加新数据上的时间。到目前为止,这是我唯一一次使用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(否)更改时,希望从“ Open Projects No SLA-Log”中获取记录以从工作表中剪切并粘贴到“ Project Log”工作表中”当前打开的SLA)”关闭。

1 个答案:

答案 0 :(得分:0)

尝试这样的事情:

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