返回列表 上一主題 發帖

刪除與複製

mistery

帖子
82 
主題
5 
精華
0 
積分
115 
點名
0  
作業系統
Vista 
軟體版本
Office 2003 
閱讀權限
20 
性別
男 
來自
Taipei 
註冊時間
2010-5-1 
最後登錄
2025-7-15 
1# 跳轉到 »
發表於 2011-1-3 17:00 | 顯示全部帖子
本帖最後由 mistery 於 2011-1-3 17:01 編輯

公式在附件寫的VBA裡

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect(Target(1), Range("C1:IV1")) Is Nothing Then
    If Target(1) <> "" Then 複製
    End If
    If Not Intersect(Target(1), Range("C2:IV2")) Is Nothing Then
    If Target(1) <> "" Then 刪除
    End If
End Sub

---------------------------------------------------------------------------------------------------------
Sub 複製()
Again:
      ZZ = Application.InputBox("請輸入列數", "請輸入複製所需欄數", 10, Type:=2)
      If ZZ = "" Or ZZ = False Then End

      If ZZ <= 1 Then
        MsgBox "欄數不得小於１列！！！", , "欄數錯誤請重新輸入 ！！"
        GoTo Again
      End If
      [G1:P360].Copy Sheet2.Range("IV1").End(xlToLeft).Offset(0, 1)
End Sub

---------------------------------------------------------------------------------------------------------
Sub 刪除()
    Dim F
Again:
      ZZ = Application.InputBox("請輸入列數", "請輸入刪除所需欄數", 10, Type:=2)
      If ZZ = "" Or ZZ = False Then End

      If ZZ <= 1 Then
        MsgBox "欄數不得小於１列！！！", , "欄數錯誤請重新輸入 ！！"
        GoTo Again
      End If
    If Sheet1.[C1] = "" Then Exit Sub
    Columns("D:M").Delete Shift:=xlToLefte
End Sub

TOP

        靜思自在 : 謊言像一朵盛開的鮮花，外表美麗，生命短暫。
返回列表 上一主題