標題: 有關複製指定貼上的問題? [打印本頁]

---

作者: lucky12345    時間: 2016-1-13 04:00     標題: 有關複製指定貼上的問題?

本帖最後由 lucky12345 於 2016-1-13 04:01 編輯

B$1:K$1=隨時更新的數值
當A$1=2 (時 ) 將B$1:K$1複製到B2:K2
當A$1=3         將B$1:K$1複製到B3:K3
當A$1=4         將B$1:K$1複製到B4:K4     ..........以此類推
當A2<=-1  Then B2:K2401="A"
請各位大大指導  謝謝

---

作者: lucky12345    時間: 2016-1-13 08:09

本帖最後由 lucky12345 於 2016-1-13 08:12 編輯

謝謝版大的回應
D1:K1  的數據 和證商DDE連結
B1=買價  =   MMSDDE|FUSA!'[email protected]'
C1=賣價    =MMSDDE|FUSA!'[email protected]'
D1=最高價
E1=最低價
F1=成交價
G1=成交張數
H1=成交時間
I1=委買量
J1=委賣量
K1=漲跌

---

作者: yen956    時間: 2016-1-13 13:26

'是不是個意思? 試試看:
'請貼到關的工作頁上
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

---

作者: lucky12345    時間: 2016-1-13 16:57

回復 3# yen956
回yen956 大      正解
非常感謝! 祝您好運  心想事成

---

作者: lucky12345    時間: 2016-1-13 18:58

本帖最後由 lucky12345 於 2016-1-13 19:07 編輯

回復 3# yen956
yen956大您好........
使用後發現兩個問題?  請您幫忙撿視一下  該如何修改  謝謝您
1. 儲存格M1=8    若K1=M1   K1當然也是=8   不過複製貼上之後 不是=8   而是=0
2. 當A1  輸入2 按Enter   就會複製一次    可是這 A1的數據 也是DDE連結   (接收外來數據)    123456789---------到2401 (A1 會固定5秒更新一次數值)
    當A1=3   會複製一次    當A1由3改變  成為4  就會觸發複製一次    當A1由4改變  成為5  就會觸發複製一次  (當A1數字改變就會自動觸發   而不是用手動按 Enter)

---

作者: yen956    時間: 2016-1-14 14:01

回復 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

複製代碼

---

作者: lucky12345    時間: 2016-1-14 14:40

yen956大.....感謝您的回應
1. 儲存格k1=2+3    等於6    然而往下複製  是=6 而且儲存格內帶著公式 =2*3  
     正解是  純數值6  內不帶公式(=2*3)

---

作者: lucky12345    時間: 2016-1-14 15:14

本帖最後由 lucky12345 於 2016-1-14 15:17 編輯

請看附檔...............


計數器在 sheet1

---

作者: yen956    時間: 2016-1-14 17:34

'改用兩個按鈕試試看!!
'跟 [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

---

作者: lucky12345    時間: 2016-1-14 19:53

本帖最後由 lucky12345 於 2016-1-14 19:55 編輯

yen956大您好
可能是我表達不是很清楚  重新寄上附檔  這樣比較方便測試   請幫忙再檢視 一下  謝謝您

---

作者: yen956    時間: 2016-1-14 20:39

本帖最後由 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連試試都沒試吧!!

---

歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)