Excel 2010 VBA - 不添加行

Question

我在Excel 2010中使用VBA創建宏，以根據DOB和狀態單元（全部在同一工作簿中）將行從一個工作表移動到另一個工作表。

該宏檢查DOB對「截止」日期，如果該行通過，該行應附加到TSP表並從Sheet1中刪除。

如果未通過，則檢查該行的「狀態」單元是否存在狀態表。如果是這樣，那麼該行應該被追加到該工作表的末尾，並從Sheet1中刪除。

如果該行不符合這兩者中的任何一個，則只需手動進行檢查，因爲它缺少數據或數據輸入不正確。

除了將行附加到工作表外，所有工作都正常。它只是替換表格的最後一行，除了OH表格以外，因爲OH表格是出於任何原因工作的。

我的宏：

Sub Move() 
' 
' Move Macro 
' 
' Keyboard Shortcut: Ctrl+Shift+M 
' Declare and set variables 
Dim CBL_DATE 
Dim totalrows, c 
Set tsp_sheet = Sheets("TSP") 
Set people = Sheets("Sheet1") 
CBL_DATE = DateAdd("yyyy", -59.5, Date) 
' Find total number of people to move 
totalrows = people.UsedRange.Rows.Count 
' Step through each row 
For Row = totalrows To 2 Step -1 
    ' Do not do anything if row is 1 
    If Row >= 2 Then 
     ' Check for CBL cut off date and move to TSP sheet 
     If Cells(Row, 3).Value < CBL_DATE Then 
      tsp_sheet.Rows(tsp_sheet.UsedRange.Rows.Count + 1).Value = people.Rows(Row).Value 
      people.Rows(Row).Delete 
     Else 
       ' Now we check for the state and if that worksheet exists, we copy to it and delete original 
      If SheetExists(Cells(Row, 2).Value) Then 
       Set st_sheet = Sheets(Cells(Row, 2).Value) 
       c = st_sheet.UsedRange.Rows.Count + 1 
       MsgBox Cells(Row, 2).Value & " " & c 
       st_sheet.Rows(c).Value = people.Rows(Row).Value 
       people.Rows(Row).Delete 
      End If 
     End If 
    End If 
Next Row 
End Sub 
' End Sub Move() 

我的表Sheet1中爲

 
Sheet 1 
Name |State |DOB 
--------------------------        Tim |MI |10/2/1978 
Bob |MI |10/5/1949 
Suesan |TN |10/8/1978  
Debra |OH |10/8/1975 

所有其他工作表是空白，儘管我很想開始在第二行插入（或計數+ 1）。

編輯：我SheetExists（）函數

' Public Function SheetExists 
Public Function SheetExists(SheetName As String) As Boolean 
Dim ws As Worksheet 
SheetExists = False 
For Each ws In ThisWorkbook.Worksheets 
    If ws.Name = SheetName Then 
     SheetExists = True 
     Exit For 
    End If 
Next ws 
End Function 

Answer 1

在沒有對功能SheetExists代碼（的）我通過

If Cells(Row, 2).Value = "OH" Then 
    Set st_sheet = Sheets("Sheet2") 

列表測試你的代碼替換

If SheetExists(Cells(Row, 2).Value) Then 
    Set st_sheet = Sheets(Cells(Row, 2).Value) 

從底部到頂部工作，這是刪除（但不是唯一可能的方式）。與條件匹配的第一行是放置在Sheet2的第2行中的第4行，因此將1行留空（由於+1）。對於後續對UsedRange的調用和第2行（日期條件）中的後續命中將覆蓋第一個查找，此空行＃1會造成一些混淆。

順便說一句If Row >= 2 Then是多餘的，因爲接地For無論如何設置邊界。

我會建議重新編寫整個子有點....

Sub Move1() 
Dim SrcRng As Range, SrcIdx As Long 
Dim TSPRng As Range, CtyRng As Range, TrgIdx As Long 
Dim CblDate As Date 

    Set SrcRng = Sheets("Sheet1").[A1] ' source sheet 
    Set TSPRng = Sheets("Sheet2").[A1] ' target for date condition 
    Set CtyRng = Sheets("Sheet2").[A1] ' target for country condition, preliminary set equal to TSP 
    CblDate = DateAdd("yyyy", -59.5, Date) 
    SrcIdx = 2       ' 1st row is header row 

    ' we stop on 1st blank in 1st column of SrcRng 
    Do While SrcRng(SrcIdx, 1) <> "" 
     If SrcRng(SrcIdx, 3) < CblDate Then 
      ' copy to TSP sheet 
      TrgIdx = GetIdx(TSPRng) 
      SrcRng(SrcIdx, 1).EntireRow.Copy TSPRng(TrgIdx, 1) 

      ' delete from source 
      SrcRng(SrcIdx, 1).EntireRow.Delete xlShiftUp 

     ElseIf SrcRng(SrcIdx, 2) = "OH" Then ' replace by your on condition re country 
      ' here you would set CtyRng acc. to some algorithm 

      ' copy to Country sheet 
      TrgIdx = GetIdx(CtyRng) 
      SrcRng(SrcIdx, 1).EntireRow.Copy CtyRng(TrgIdx, 1) 

      ' delete from source 
      SrcRng(SrcIdx, 1).EntireRow.Delete xlShiftUp 

     Else 
      ' we don't increment after deletions, because all records move up anyhow 
      SrcIdx = SrcIdx + 1 

     End If 

    Loop 

End Sub 

Function GetIdx(InRng As Range) As Long 
' find row number of 1st empty row in 1st column of range InRng 

    GetIdx = 1 
    Do While InRng(GetIdx, 1) <> "" 
     GetIdx = GetIdx + 1 
    Loop 

End Function 

當然，如果你設置你的目標牀單[A2]代替A1你開始在第二插入線....

希望幫助

好運拾音

後接受編輯

有什麼問題：

的根本原因顯然是UsedRange.Rows.Count回報爲空白表格（至少在Excel 2003中）可能會出乎意料。這意味着通過寫入...UsedRange.Rows.Count + 1，您的第一條記錄被插入到空白表的第2行。不幸的是，對於工作表中的單個行（第2行或其他地方），您會得到相同的結果，從而導致第二個數據記錄覆蓋第一個數據記錄，等等，因爲行數永遠不會增加。

我與調試步行通過這個小小的

Sub test() 
    Debug.Print ActiveSheet.UsedRange.Rows.Count 
End Sub