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



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

这是针对我正在创建的项目管理数据库,以减少添加新数据所花费的时间。到目前为止,这是我唯一一次使用 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

希望当项目状态的输入表单数据从"打开的项目(当前没有打开的SLA("更改为已关闭时,从工作表中剪切出"打开的项目无SLA - 日志"中的记录并粘贴到"项目日志"工作表中。

尝试这样的事情:

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

最新更新