返回列表 上一主題 發帖

如何做到對日期的checking

回復 1# patrickccs

參考看看
  1. Private Sub CommandButton1_Click()
  2. If [a2] = Date Then
  3. [a2].EntireRow.Delete
  4. Range("a2:G" & [a65536].End(3).Row).Copy
  5. Sheets("sheet1").Select
  6. Sheets("sheet1").[a2].Select
  7. Selection.PasteSpecial xlPasteValues
  8. Else: Range("a2:G" & [a65536].End(3).Row).Copy
  9. Sheets("sheet1").Select
  10. Sheets("sheet1").[a2].Select
  11. Selection.PasteSpecial xlPasteValues
  12. End If
  13. End Sub
複製代碼

TOP

回復 4# patrickccs


    試試看在sheet1加入這個
  1. Private Sub Worksheet_Change(ByVal Target As Range)
  2. With Target
  3.   If .Column = 1 And .Row = 15 Then
  4.     For Each mr In [a2:a10]
  5.       If mr = [a15] Then
  6.         tg = mr.Row
  7.       End If
  8.      Next
  9.    For i = 2 To 7
  10.      Cells(15, i) = Cells(tg, i) - Cells(tg - 1, i)
  11.    Next
  12.   End If
  13. End With
  14. End Sub
複製代碼

TOP

本帖最後由 owen06 於 2014-9-8 10:54 編輯
  1. Private Sub CommandButton2_Click()
  2. For Each mr In [a2:a10]
  3.       If mr = [a15] Then
  4.         tg = mr.Row
  5.       End If
  6.      Next
  7.    For i = 2 To 7
  8.      Cells(15, i) = Cells(tg, i) - Cells(tg - 1, i)
  9. Next
  10. End Sub
複製代碼

TOP

回復 9# patrickccs


    改良了一下,你試試吧
  1. Private Sub CommandButton1_Click()
  2. [b15:G15].Clear
  3. For Each mr In Range("a2:a" & [a1].End(4).Row)
  4.       If mr = [a15] Then
  5.         tg = mr.Row
  6.       End If
  7. On Error Resume Next
  8.      Next
  9.    For i = 2 To 7
  10.      Cells(15, i) = Cells(tg, i) - Cells(tg - 1, i)
  11. Next
  12. End Sub
複製代碼

TOP

本帖最後由 owen06 於 2014-9-10 12:58 編輯

回復 11# patrickccs


    如果想在其他工作表執行另一個工作表的內容,那就要在指令的範圍前面,加上明確的sheet名稱,才不會迷路。
    例如

Private Sub CommandButton1_Click()
sheets("sheet1").[b15:G15].Clear
For Each mr In sheets("sheet1").Range("a2:a" & sheets("sheet1").[a1].End(4).Row)
      If mr = sheets("sheet1").[a15] Then
        tg = mr.Row
      End If
On Error Resume Next
     Next
   For i = 2 To 7
     sheets("sheet1").Cells(15, i) = sheets("sheet1").Cells(tg, i) - sheets("sheet1").Cells(tg - 1, i)
Next
End Sub

TOP

        靜思自在 : 有願放在心裡,沒有身體力行,正如耕田不播種,皆是空過因緣。
返回列表 上一主題