[發問] 請教外部資料匯入時間,變成非表格,要如何恢復成表格?

bhsm

同一網站匯入外部資料時,只有"股本形成"及"基本資料"能維持網站上表格形式,其他都以非表格顯示,請教各位高手要如何讓外部資料恢復表格形式?謝謝
1.rar (111.35 KB)

下載次數: 8

2022-10-23 18:03

bhsm

回復 10# Andy2483
謝謝您不吝指教,或許是excel版本問題,小弟的excel一樣是與您最原始的檔案一樣,要按TEST的按鈕才能表格化

Andy2483

回復 9# bhsm


    請前輩下載試試看

T-1_20230223_1.zip (125.95 KB)

下載次數: 7

2023-2-23 15:47

bhsm

回復 8# Andy2483
小弟不才,請問整個VBA要如何寫,謝謝

Andy2483

回復 7# bhsm

可能是EXCEL觸發失效了,執行以下 Sub 恢復觸發() 讓觸發恢復後,[A1]再輸入,試試看
Sub 恢復觸發()
Application.EnableEvents = True
End Sub

bhsm

回復 6# Andy2483
直接改用您的建議,還是無法Call TEST耶!

Andy2483

回復 5# bhsm


    謝謝前輩再回復
以下程式碼請試試看

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$A$1" Then
'↑如果觸發格位址是[A1]
   Range("B1").Select
   '↑儲存格游標選取[B1]儲存格
   Call TEST
   '↑執行副程式(TEST)
End If
End Sub
===============================
[B1]有公式,所以後學猜測前輩是要在[A1]輸入後觸發>執行副程式

bhsm

回復 3# Andy2483
請教Andy2483大:
您教導的這個VBA要如何在工作表中使用"Call"呼叫它呢?我在工作表1中用"Call"呼叫它卻無法自動執行,請問要如何能用"Call"呼叫"TEST"VBA呢?謝謝 T-1.rar (130.68 KB)

下載次數: 4

2023-2-23 11:00

bhsm

回復 3# Andy2483
感謝您的指導,可以使用了,後續若有其他問題請教,尚請不吝指教

Andy2483

前輩早安!
今天早上將昨天猜測情境練習陣列的程式碼心得註解一下!
請各位前輩指正並指導! 謝謝!

Option Explicit
Sub TEST()
Dim Brr, Arr, Crr, c&, i&, x&, xR, R&, T, V, Y, Z
Dim B#, j, K%, P$, Q, Ra
'↑宣告變數
Y = Array("季累計損益表", "資產負債簡表", "累計現金流量季表", "現金流量年表", "損益年表")
'↑令Y 是一維陣列 倒入 5個表的名稱字串
For j = 0 To UBound(Y)
'↑設順外迴圈
   Brr = Sheets(Y(j)).Range(Sheets(Y(j)).[B3], Sheets(Y(j)).Cells(Rows.Count, 2).End(3))
   '↑令Brr陣列裝入Y 各個表的關鍵字串!
   ReDim Arr(1 To UBound(Brr), 1 To 99)
   '↑宣告Arr空陣列的列數同Brr!欄數99欄
   For i = 1 To UBound(Brr)
   '↑設順中迴圈
      If Trim(Brr(i, 1)) = "" Then
      '↑如果關鍵字串去頭尾的空白字元後是空字元?
         GoTo 111
         '↑條件成立!就跳到 111 的位置繼續執行
      End If
      Crr = Split(Trim(Brr(i, 1)), " ")
      '↑將關鍵字串去頭尾的空白字元後,以空白字元分割字串成為Crr一維陣列
      For x = 0 To UBound(Crr)
      '↑設順內迴圈!從0到Crr陣列的後一個
         Arr(i, x + 1) = Crr(x)
         '↑將Crr一維陣列帶入Arr的二維陣列!
      Next
   
111
   Next
   Sheets(Y(j)).[C3].Resize(UBound(Arr), 99) = Arr
   '↑將各個表從[C3]開始貼入結果資料
Next
Set Arr = Nothing
Set Brr = Nothing
Set Crr = Nothing
End Sub