請問調整一維陣列大小的方式

各位大大 :
請教一下, 小弟我想寫個程式 , 把某個數(如10^6)以下的質數全部抓出來
小弟我不想用把質數找到後 , 逐一寫入儲存格方式 , 這樣比較慢
而是想用 , 先質數逐一寫入一維陣列 , 如ReDim arr(1 To 10^6)
最後再把這一維陣列貼到儲存格如 cells(1,1).resize(10^6, 1)=arr
我想問 , 如果我的陣列預設10^6大小 , 但是沒有寫滿, 例如只寫入10^5
我要如何調整陣列大小 , 讓陣列只保留有寫入的位置(沒有寫入的刪除)
謝謝~

例如下方簡單程式, arr預設10個位置 , 最後只有arr(1) ~ arr(5)有寫入資料
我如何把arr縮小成只有5個位置? 把沒有寫入的位置刪除

Sub test()
ReDim arr(1 To 10)
n = 0
For i = 1 To 5
n = n + 1
arr(i) = n
Next
End Sub

樓主熱帖

MLB

stillfish00

大學生 Rank: 4

帖子: 1018
主題: 15
精華: 0
積分: 1058
點名: 0
作業系統: win7 32bit
軟體版本: Office 2016 64-bit
閱讀權限: 50
性別: 男
來自: 桃園
註冊時間: 2012-5-9
最後登錄: 2022-9-28

2^#

發表於 2020-1-9 10:53 | 只看該作者

回復 1# mlbolerud
後面加一行
ReDim Preserve arr(1 To 5)

表達不清、題意不明確、沒附檔案格式、沒有討論問題的態度~~~~~~以上愛莫能助。

TOP

mlbolerud

中學生 Rank: 2

帖子: 32
主題: 13
精華: 0
積分: 70
點名: 0
作業系統: Window 7
軟體版本: office 2007
閱讀權限: 20
性別: 男
來自: 台灣
註冊時間: 2019-4-28
最後登錄: 2021-7-6

3^#

發表於 2020-1-9 12:30 | 只看該作者

stillfish00大大
非感謝你的建議, 但是我的例子(10^6以下的質數) , 個數有多少, 我一開始不會知道
所以我一開始只能建一個很大的一維陣列(避免寫不下) , 然後把質數找到後逐一寫入
最後寫完 , 沒有填滿的陣列位置 , 我想要把它刪除
我知道可以用寫迴圈的方式 , 判斷陣列裡的值len是否=0 , 計算質數個數
但是不知道有沒有不寫迴圈的指令可以用?
感謝了~

MLB

TOP

stillfish00

大學生 Rank: 4

帖子: 1018
主題: 15
精華: 0
積分: 1058
點名: 0
作業系統: win7 32bit
軟體版本: Office 2016 64-bit
閱讀權限: 50
性別: 男
來自: 桃園
註冊時間: 2012-5-9
最後登錄: 2022-9-28

4^#

發表於 2020-1-9 13:19 | 只看該作者

本帖最後由 stillfish00 於 2020-1-9 13:24 編輯

回復 3# mlbolerud
沒有要你再用一個迴圈，你判斷是質數放到arr的時候就要塞到前面

Sub Test1()
Dim arr(1 To 100)
Dim cnt As Long
cnt = 0
For i = 1 To 100
If 是質數(i) Then
cnt = cnt + 1
arr(cnt) = i
End If
Next
ReDim Preserve arr(1 To cnt)
End Sub

複製代碼

表達不清、題意不明確、沒附檔案格式、沒有討論問題的態度~~~~~~以上愛莫能助。

TOP

mlbolerud

中學生 Rank: 2

帖子: 32
主題: 13
精華: 0
積分: 70
點名: 0
作業系統: Window 7
軟體版本: office 2007
閱讀權限: 20
性別: 男
來自: 台灣
註冊時間: 2019-4-28
最後登錄: 2021-7-6

5^#

發表於 2020-1-9 21:34 | 只看該作者

本帖最後由 mlbolerud 於 2020-1-9 21:38 編輯

stillfish00大大
非常感謝你建議的方式 , 這是很好的建議
用這個方式 , 確實就可以在迴圈跑完就得到 , 陣列寫入的長度

我另外再請教個小問題, 如果我的一維陣列長度比較長, 例如10^5
我發現寫入儲存格時會出現 "型態不符合" 的錯誤
如果陣列短一點(<=65536) , 就可以寫入 , 我用什麼方式可以解決這問題呢?
我試過把陣列宣告成長整數( Dim arr() As long ) 沒有用, 如下範例
還望大大能不吝賜教
感謝了

Sub test1()
Dim arr() As Variant
ReDim arr(1 To 10 ^ 5)
n = 1
Do
   arr(n) = n
   n = n + 1
Loop While n < 10 ^ 5 + 1
Sheets(2).Cells(1, 1).Resize(10 ^ 5, 1) = Application.Transpose(arr)  ''''''''''' 無法寫入
End Sub

MLB

TOP

mlbolerud