返回列表 上一主題 發帖

有關複製指定貼上的問題?

'是不是個意思? 試試看:
'請貼到關的工作頁上
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Rng As Range
    If Target.Count > 1 Then Exit Sub
    If Target <> [A1] And Target <> [A2] Then Exit Sub
    If Target = [A2] And [A2] = -1 Then
        [B2:K2401] = "A"
    ElseIf Target = [A1] And [A1] > 1 Then
        [B2:K2401] = ""    '舊資料要不要清除? 如不清除請將這列註解掉
        Set Rng = [B$1:K$1]
        Rng.Copy Rng.Offset([A1] - 1, 0)
    End If
End Sub

TOP

回復 5# lucky12345
Q1. 儲存格M1=8    若K1=M1   K1當然也是=8   不過複製貼上之後 不是=8   而是=0       
A1. 將 K1 公式改為 =M$1       
Q2. 我弄錯你的原意,        
原來是想要手動更新,
試試看:
  1. '請貼到關的工作頁上
  2. Private Sub Worksheet_Change(ByVal Target As Range)
  3.     Dim Rng As Range
  4.     Dim Ans As Integer
  5.     If Target.Count > 1 Then Exit Sub
  6.     If Target <> [A1] And Target <> [A2] Then Exit Sub
  7.     If Target = [A2] And [A2] = -1 Then
  8.         Ans = MsgBox("是否要將 [B2:K2401] 的資料將全部用 'A' 覆蓋?", vbYesNo)
  9.         If Ans = 7 Then Exit Sub
  10.         [B2:K2401] = "A"
  11.     ElseIf Target = [A1] And [A1] > 1 Then
  12. '        [B2:K2401] = ""    '舊資料要不要清除? 如不清除請將這列解掉
  13.         Ans = MsgBox("是否要開始複製資料?", vbYesNo)
  14.         If Ans = 7 Then Exit Sub
  15.         Set Rng = [B$1:K$1]
  16.         Rng.Copy Rng.Offset([A1] - 1, 0)
  17.     End If
  18. End Sub
複製代碼

TOP

'改用兩個按鈕試試看!!
'跟 [A6] 有關嗎? 依[A1] 或 [A6] 指定列, 貼上第一列的值?
'下列係依[A1]指定列, 貼上第一列的值
Private Sub CommandButton1_Click()
    Dim Rng As Range, Lst As Integer
    If [A1] > 1 Then
        Set Rng = [B$1:K$1]
        Rng.Copy
        Rng.Offset([A1] - 1, 0).PasteSpecial Paste:=xlPasteValues   '只貼上值, 公式格式等不會貼上
    End If
End Sub

'用'A'覆蓋或全部清除
Private Sub CommandButton2_Click()
    If [A2] = -1 Then
        '下列二選一, 不要用到的, 請在前面加 '
        '
        [B2:K2401] = "A"    '全部用'A'覆蓋
'        [B2:K2401] = ""     '全部清除
    End If
End Sub

TOP

本帖最後由 yen956 於 2016-1-14 20:40 編輯

1.Sorry, 忘了請你刪除上次 Worksheet_Change(自動執行) 的VBA
Private Sub Worksheet_Change(ByVal Target As Range)
...
End Sub
2.『sheet2!A1 不接受sheet1G12計數(數值) 無法自動複製  只能用手動輸入 數字  按Enter 才會複製一次』
ANS:所以才改用按鈕, 手動啟動下列VBA
Private Sub CommandButton1_Click()
    Dim Rng As Range, Lst As Integer
    If [A1] > 1 Then
        Set Rng = [B$1:K$1]
        Rng.Copy
        Rng.Offset([A1] - 1, 0).PasteSpecial Paste:=xlPasteValues   '只貼上值, 公式格式等不會貼上
    End If
End Sub
3. 連[A2]=-1也改成手動, 所以要兩個按鈕
4. 你 9# 的VBA連試試都沒試吧!!

TOP

        靜思自在 : 吃苦了苦、苦盡廿來,享福了福、福盡悲來。
返回列表 上一主題