Hsieh

回復 10# jackdream


    我想樓主最主要的意思是想只要a欄變動
b欄以後公式就能代入a欄的值
我沒有dde的軟體
把代碼貼在該工作表模組內試試

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2. If Target <> "" And Target.Column = 1 Then
   
3. Application.EnableEvents = False
   
4. i = InStr(Target.Offset(, 1).Formula, "'")
   
5. k = InStr(Target.Offset(, 1).Formula, "`")
   
6. mystr = Mid(Target.Offset(, 1).Formula, i + 1, k - i - 1)
   
7. Range(Target.Offset(, 1), Target.Offset(, 1).End(xlToRight)).Replace mystr, Target, xlPart
   
8. Application.EnableEvents = True
   
9. End If
   
10. End Sub

複製代碼

Book.rar (10.18 KB)

下載次數: 2

2010-7-27 14:46

cheng17875

回復 10# jackdream


   

下載 (51.71 KB)

2010-7-27 16:00

下載 (47.54 KB)

2010-7-27 16:01

感謝各位大大的幫忙 !  太感心了  不過我有需要說明

我的儲存格內都無公式或程式
只有軟體連結來源的內碼
唯一想要在A欄  key 股票代號  就可以改變B/C/D.....各欄內 軟體連結來源內碼(eMidst|SW!'9907`1019')
紅色位置就是股票代碼

luhpro

回復 9# cheng17875

這個主題中的程式是必須有同時在 Windows 上執行 "精x的股票看盤軟體" 才能看到實際結果,
附檔是我在公司時參照第一帖圖示與上方 6# jackdream 大大的程式片段做出來的,
雖然不是用你後來上傳的檔案做例子測的,
應該仍然還是可以正常使用才是.

'===== 以下程式放在 Sheet1 =====
Private Sub Worksheet_Change(ByVal Target As Range)

  Dim iI As Integer, iRow As Integer


  iRow = ActiveSheet.Cells(2, 2).End(xlDown).Row
   
  For iI = 2 To iRow
    If Not Intersect(Target, ActiveSheet.Cells(iI, 1)) Is Nothing Then '若有更改 Ax 內容

        If Not Cells(Target.Row, Target.Column) = Empty Then

        Call Change(iI)

        End If

    End If
  Next iI

End Sub


'===== 以下程式放在 Module1 =====
Sub Change(iI)

  Dim iJ As Integer, iCol As Integer, iRow As Integer
  Dim sStr As String


  With Sheets(1)
    iCol = .Cells(2, 1).End(xlToRight).Column
   
      For iJ = 2 To iCol
        sStr = .Cells(iI, iJ).Formula
        sStr = Left(sStr, 12) & .Cells(iI, 1).Value & Mid(sStr, 17, Len(sStr) - 16)
        .Cells(iI, iJ).Formula = sStr
      Next iJ
  End With

End Sub

Book_a.zip (10.06 KB)

下載次數: 2

2010-7-27 19:30

cheng17875

回復 13# luhpro


    感謝各位大大  給我方向
努力學習中   爾後再請各位不吝教導  感謝啦!!!

cheng17875

回復 13# luhpro


    不知道我哪裡做錯了!  有請各位先進指導  感恩

下載 (178.53 KB)

2010-7-29 11:29

下載 (52.92 KB)

2010-7-29 11:30

如果大大可以 指導步驟更好  這樣我就可以學到更多
感恩感恩

Hsieh

回復 15# cheng17875


    程序名稱module1改成Change(iI)

cheng17875

回復 16# Hsieh
不好意思! 讓大家多幫忙了..不過我似乎慢慢有點認識皮毛了   如果可以的話  也希望大大能教導一下製作過程圖解
執行大致上OK
但有問題發生

下載 (72.72 KB)

2010-7-30 11:18

下載 (43.4 KB)

2010-7-30 11:18

下載 (65.53 KB)

2010-7-30 11:18

下載 (97.97 KB)

2010-7-30 11:18

另有問題可否幫忙解答:
假如我把DDE連結的換成另一套券商報價軟體
內碼不一了 程式碼會需要變更哪些地方呢??如圖

下載 (57.61 KB)

2010-7-30 11:36

luhpro

回復 17# cheng17875

第 1 個問題我也有發現到,
主要是因為股票代號的字數並非固定為 4 碼,
所以要改成找關鍵字 "`",
部分程式修改如下請自行帶入 :
        dim iNum%

        sStr = .Cells(iI, iJ).Formula
        iNum = InStr(1, sStr, "`", 1)
        sStr = Left(sStr, 12) & .Cells(iI, 1).Value & Mid(sStr, iNum, Len(sStr) - iNum + 1)
        .Cells(iI, iJ).Formula = sStr

至於公式的修改方式主要就是取代掉 "股票代號" 的部份,
例如 精x 的公式 :
股票名稱  =eMidst|SW!'2330`1019'
股價          =eMidst|SW!'2330`205'
就是用 left()抓 2330 前面的字串 + 新的股票代號 + 2330 的 "0" 後面那個字 "`" 開始的字串來取代原公式即可.

而那另一個軟體的公式相同的以 2388 為基礎做字串分拆,
後面那個字串就抓 "8" 後面那個 "." 開始的字串就可以了.

當然還有一個方法就是不管原儲存格的內容,
直接將公式內的文字 Copy 下來分拆,
再將字串組合後丟給原儲存格就可以了,
例如 精x 的改用 :
        sStr = "=eMidst|SW!'" & .Cells(iI, 1).Value  & "`1019'"
        .Cells(iI, iJ).Formula = sStr
缺點是公式已經定死在程式中,
若儲存格互相對調位置也必須改程式,
彈性較小.