有請解答! 如何製作此一欄位??

帖子: 9
主題: 1
精華: 0
積分: 10
點名: 0
作業系統: XP
軟體版本: 2000
閱讀權限: 10
註冊時間: 2010-7-26
最後登錄: 2010-8-14

12^#

發表於 2010-7-27 16:01 | 只看該作者

本帖最後由 cheng17875 於 2010-7-27 16:09 編輯

回復 10# jackdream

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

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

luhpro

高中生 Rank: 3 Rank: 3

帖子: 824
主題: 6
精華: 0
積分: 904
點名: 0
作業系統: Win 10,7
軟體版本: 2019,2013,2003
閱讀權限: 50
性別: 男
註冊時間: 2010-5-3
最後登錄: 2023-12-24

13^#

發表於 2010-7-27 19:31 | 只看該作者

本帖最後由 luhpro 於 2010-7-27 19:33 編輯

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

帖子: 9
主題: 1
精華: 0
積分: 10
點名: 0
作業系統: XP
軟體版本: 2000
閱讀權限: 10
註冊時間: 2010-7-26
最後登錄: 2010-8-14

14^#

發表於 2010-7-28 17:13 | 只看該作者

回復 13# luhpro

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

帖子: 9
主題: 1
精華: 0
積分: 10
點名: 0
作業系統: XP
軟體版本: 2000
閱讀權限: 10
註冊時間: 2010-7-26
最後登錄: 2010-8-14

15^#

發表於 2010-7-29 11:31 | 只看該作者

回復 13# luhpro

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

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

Hsieh

超級版主 Rank: 8 Rank: 8

帖子: 4901
主題: 44
精華: 24
積分: 4916
點名: 149
作業系統: Windows 7
軟體版本: Office 20xx
閱讀權限: 150
性別: 男
來自: 台北
註冊時間: 2010-4-30
最後登錄: 2024-6-28

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

16^#

發表於 2010-7-29 15:53 | 只看該作者

回復 15# cheng17875

程序名稱module1改成Change(iI)

學海無涯_不恥下問

帖子: 9
主題: 1
精華: 0
積分: 10
點名: 0
作業系統: XP
軟體版本: 2000
閱讀權限: 10
註冊時間: 2010-7-26
最後登錄: 2010-8-14

17^#

發表於 2010-7-30 11:19 | 只看該作者

本帖最後由 cheng17875 於 2010-7-30 11:37 編輯

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

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

luhpro

高中生 Rank: 3 Rank: 3

帖子: 824
主題: 6
精華: 0
積分: 904
點名: 0
作業系統: Win 10,7
軟體版本: 2019,2013,2003
閱讀權限: 50
性別: 男
註冊時間: 2010-5-3
最後登錄: 2023-12-24

18^#

發表於 2010-7-30 21:07 | 只看該作者

本帖最後由 luhpro 於 2010-7-30 21:14 編輯

回復 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
缺點是公式已經定死在程式中,
若儲存格互相對調位置也必須改程式,
彈性較小.