現有一網址，存在以下
0318,0319,0320,0321,0324,0325, ... ,0905
51.5,52.3,53,50.8,51.3,49.3, ... ,37.5
570022,582651,590815,591013, ... ,159892
240820,240828,239079,235128, ... ,134154
113544,113794,113486,113155, ... ,142004
8986,12128,8885,115,9103, ... ,-724
15847,29,3031, ... ,2545
-1406,8,-1749, ... ,-11691
776,250,-308, ... ,-724
我希望AI能幫我寫寫CODE，讓我省心。
指令：
第一次回饋：
Sub TransformData()
Dim wsSrc As Worksheet, wsDest As Worksheet
Dim lastRow As Long, lastCol As Long
Dim i As Long, j As Long
Dim headers() As String, values() As String
Dim indicatorNames As Variant
Dim destRow As Long
' 請自行調整指標名稱（例如收盤價、成交量、內盤... 依你原始檔順序）
indicatorNames = Array("日期", "收盤價", "成交量", "內盤量", "外盤量", _
"未知指標6", "未知指標7", "未知指標8", "未知指標9") ' 請補足所有行
Set wsSrc = Worksheets("Sheet1")
Set wsDest = Worksheets.Add(after:=wsSrc)
wsDest.Name = "拆解後"
lastRow = wsSrc.Cells(wsSrc.Rows.Count, 1).End(xlUp).Row
' 讀取日期（第1行）
headers = Split(wsSrc.Cells(1, 1).Value, ",")
destRow = 1
wsDest.Cells(destRow, 1).Value = "日期"
wsDest.Cells(destRow, 2).Value = "指標名稱"
wsDest.Cells(destRow, 3).Value = "數值"
' 每一行資料均拆成多行
For i = 2 To lastRow '第2行開始為指標
values = Split(wsSrc.Cells(i, 1).Value, ",")
For j = 0 To UBound(headers)
destRow = destRow + 1
wsDest.Cells(destRow, 1).Value = headers(j)
wsDest.Cells(destRow, 2).Value = indicatorNames(i - 1)
wsDest.Cells(destRow, 3).Value = values(j)
Next j
Next i
MsgBox "拆解完成，結果在 '" & wsDest.Name & "' 工作表！"
End Sub
使用說明
indicatorNames 要照你貼上的每一行實際意義命名，如果你不確定可以先用「指標1」「指標2」…。
結果會生成在新工作表「拆解後」。
若你的原始資料不在 A1 往下，請修改程式 on wsSrc.Cells(行, 1) 為你實際起始位置。
我希望AI能連同爬蟲+資料拆解一起協助我。
直接抱怨AI.......
指令：
VBA 爬蟲＋資料拆解 方案
網址資料自動下載
自動拆解還原成日期、指標、數值長表
你只要修改網址和原始Sheet/起始位置
第二次的CODE
Sub CrawlAndTransformData()
Dim http As Object
Dim wsDest As Worksheet
Dim lines() As String
Dim indicatorNames() As String
Dim headers() As String, values() As String
Dim rawData As String
Dim i As Long, j As Long
Dim destRow As Long
Dim Url As String
' 更換為你的原始網址
Url = "https://XXXXX.moneydj.com/Z/ZC/ZCL/XXXXX.XXXXX?A=2027&B=Y"
Set http = CreateObject("WinHttp.WinHttpRequest.5.1")
http.Open "GET", Url, False
http.Send
rawData = http.ResponseText
' 假設都是以換行(\n或\r\n)分段
lines = Split(Replace(rawData, vbCr, ""), vbLf)
' 生成新工作表
Set wsDest = Worksheets.Add
wsDest.Name = "拆解後"
' 指標名稱（你可自行修改，超過自動命名）
ReDim indicatorNames(UBound(lines))
indicatorNames(0) = "日期"
For i = 1 To UBound(lines)
indicatorNames(i) = "指標" & i
Next
' 開頭標題
wsDest.Cells(1, 1).Value = "日期"
wsDest.Cells(1, 2).Value = "指標名稱"
wsDest.Cells(1, 3).Value = "數值"
destRow = 1
' 解析
headers = Split(lines(0), ",")
For i = 1 To UBound(lines) '第一行(0)為日期，1起為指標
values = Split(lines(i), ",")
For j = 0 To UBound(headers)
destRow = destRow + 1
wsDest.Cells(destRow, 1).Value = headers(j)
wsDest.Cells(destRow, 2).Value = indicatorNames(i)
wsDest.Cells(destRow, 3).Value = values(j)
Next
Next
MsgBox "資料爬取與拆解完成！"
End Sub
經過小編貼在VBA的模組後，測試會有點BUG。
所以小編決定自己修改幾個細節。
小編版：
Sub CrawlAndTransformData()
Dim http As Object
Dim wsDest As Worksheet
Dim lines() As String
Dim indicatorNames() As String
Dim headers() As String, values() As String
Dim rawData As String
Dim i As Long, j As Long
Dim destRow As Long
Dim Url As String
' 更換為你的原始網址
Url = "https://XXXX.moneydj.com/Z/ZC/ZCL/XXXX.XXXX?A=2027&B=Y"
Set http = CreateObject("WinHttp.WinHttpRequest.5.1")
http.Open "GET", Url, False
http.Send
rawData = http.ResponseText
lines = Split(rawData, " ")
Set wsDest = ActiveSheet 'Worksheets.Add
wsDest.Cells.Clear
' 開頭標題
Tag = Array("日期", "收盤價", "外資", "投信", "自營商", "單日合計外資", "單日合計投信", "單日合計自營商")
ActiveSheet.Range("a1:H1") = Tag
For i = LBound(lines) To UBound(lines) '第一行(0)為日期，1起為指標
values = Split(lines(i), ",")
target = Split(ActiveSheet.Cells(1, i + 1).Address, "$")
ActiveSheet.Range(target(1) & "2").Resize(UBound(values) + 1, 1).Value = Application.WorksheetFunction.Transpose(values)
Next
MsgBox "資料爬取與拆解完成！"
End Sub
小編有網址遮掉，請見諒。
沒有留言:
張貼留言