[發問] [發問] VBA填入公式

帖子: 561
主題: 160
精華: 0
積分: 725
點名: 0
作業系統: WINDOWS
軟體版本: xp
閱讀權限: 50
性別: 男
來自: 桃園
註冊時間: 2014-9-10
最後登錄: 2024-8-7

論壇榮譽勳章論壇贊助勳章熱烈參與勳章

2^#

發表於 2018-12-4 15:03 | 只看該作者

試試

Sub TEST()
Sheet1.[B2:B65536].ClearContents
X = Sheet1.[A65536].End(xlUp).Row
Y = Sheet1.[B65536].End(xlUp).Row
For M = 2 To X
Sheet1.Cells(Y + 1, 2) = Mid(Sheet1.Cells(M, 1), 1, 3)
Y = Y + 1
Next
End Sub

羅

ABK

帖子: 115
主題: 24
精華: 0
積分: 178
點名: 2
作業系統: WIN10
軟體版本: Office2016
閱讀權限: 20
性別: 男
註冊時間: 2011-1-12
最後登錄: 2024-11-15

3^#

發表於 2018-12-4 17:14 | 只看該作者

回復 2# rouber590324

感謝Rouber大 !

ABK

帖子: 115
主題: 24
精華: 0
積分: 178
點名: 2
作業系統: WIN10
軟體版本: Office2016
閱讀權限: 20
性別: 男
註冊時間: 2011-1-12
最後登錄: 2024-11-15

4^#

發表於 2018-12-4 17:19 | 只看該作者

除了迴圈還其他的方法嗎?
一個工作簿有時候要跑 40多個Sheet，每一個Sheet 都有一兩千行資料，
用迴圈跑要耗一些時間 !

n7822123

　暱稱: 阿龍

帖子: 406
主題: 8
精華: 0
積分: 453
點名: 0
作業系統: WINDOWS 7
軟體版本: 2007
閱讀權限: 20
性別: 男
來自: 台灣
註冊時間: 2015-2-7
最後登錄: 2021-7-31

5^#

發表於 2018-12-5 01:21 | 只看該作者

回復 4# ABK

40個sheet 每個sheet算2000筆，也才8萬筆資料呀

VBA寫的好應該不需要太久才是，寫函數保證更慢，更卡

程式是依需求寫的，需求表達不清楚
或者沒有上傳附件，愛莫能助

Scott090

帖子: 519
主題: 54
精華: 0
積分: 595
點名: 256
作業系統: win 10
軟體版本: []
閱讀權限: 50
性別: 男
註冊時間: 2013-3-19
最後登錄: 2024-11-23

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章論壇榮譽勳章論壇贊助勳章 2015羊年全勤獎章

6^#

發表於 2018-12-5 05:45 | 只看該作者

回復 4# ABK

用陣列處理應該會比每個儲存格分別處理來得快

n7822123

　暱稱: 阿龍

帖子: 406
主題: 8
精華: 0
積分: 453
點名: 0
作業系統: WINDOWS 7
軟體版本: 2007
閱讀權限: 20
性別: 男
來自: 台灣
註冊時間: 2015-2-7
最後登錄: 2021-7-31

7^#

發表於 2018-12-5 13:38 | 只看該作者

本帖最後由 n7822123 於 2018-12-5 13:41 編輯

回復 6# Scott090

scotto90 大大所言即是，用陣列會比較快，
因為版大沒有提供檔案，所以我就只寫一個sheet的VBA做為參考

Sub test()
Dim Arr, i%
Arr = Range([A1], Cells(Rows.Count, 1).End(3))
For i = 1 To UBound(Arr): Arr(i, 1) = Left(Arr(i, 1), 3): Next
[B1].Resize(UBound(Arr)) = Arr
End Sub

程式是依需求寫的，需求表達不清楚
或者沒有上傳附件，愛莫能助

Scott090

帖子: 519
主題: 54
精華: 0
積分: 595
點名: 256
作業系統: win 10
軟體版本: []
閱讀權限: 50
性別: 男
註冊時間: 2013-3-19
最後登錄: 2024-11-23

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章論壇榮譽勳章論壇贊助勳章 2015羊年全勤獎章

8^#

發表於 2018-12-6 14:50 | 只看該作者

回復 7# n7822123

假設工作簿內每個工作表的格式都一樣
且工作表的第一列是欄位名稱
Sub test()
   Dim Arr, sh
   For Each sh In Sheets
         With sh
               Arr = Range(.[A2], .[A1].Cells(.Rows.Count, 1).End(3))
               For i = 1 To UBound(Arr): Arr(i, 1) = Left(Arr(i, 1), 3): Next
               .[B2].Resize(UBound(Arr)) = Arr
         End With
   Next
End Sub

  這樣也許可以很快把40幾個工作表做完

Scott090

帖子: 519
主題: 54
精華: 0
積分: 595
點名: 256
作業系統: win 10
軟體版本: []
閱讀權限: 50
性別: 男
註冊時間: 2013-3-19
最後登錄: 2024-11-23

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章論壇榮譽勳章論壇贊助勳章 2015羊年全勤獎章

9^#

發表於 2018-12-6 15:21 | 只看該作者

回復 1# ABK

在 B 攔填入公式：

cells(2,"B").formula = "= LEFT(A2,3)"
cells(3,"B").formula = "= LEFT(A3,3)"

n7822123

　暱稱: 阿龍

帖子: 406
主題: 8
精華: 0
積分: 453
點名: 0
作業系統: WINDOWS 7
軟體版本: 2007
閱讀權限: 20
性別: 男
來自: 台灣
註冊時間: 2015-2-7
最後登錄: 2021-7-31

10^#

發表於 2018-12-7 00:15 | 只看該作者

本帖最後由 n7822123 於 2018-12-7 00:20 編輯

回復 8# Scott090

喔喔，沒注意到第一列是標題列
用VBA寫函數就更簡單了，不用迴圈，一行解決
函數裡的A2會自動變更為A3,A4,A5

[B2].Resize([A1].End(4).Row-1) = "=LEFT(A2,3)"

程式是依需求寫的，需求表達不清楚
或者沒有上傳附件，愛莫能助