[發問]將兩陣列依順序合併問題

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

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

2^#

發表於 2011-1-13 10:49 | 只看該作者

回復 1# asus103
有些數值跟你A、B陣列取得方式有關
以儲存格範圍為陣列為例

Sub nn()
Dim Ar(), Ay(), C(), A, B
A = [B1:D2]: B = [F1:I2]
For i = LBound(A, 1) To UBound(A, 1)
For j = LBound(A, 2) To UBound(A, 2)
ReDim Preserve Ar(s)
Ar(s) = A(i, j) '取得A陣列
s = s + 1
Next
For j = LBound(B, 2) To UBound(B, 2)
ReDim Preserve Ar(s)
Ar(s) = B(i, j) '取得B陣列
s = s + 1
Next
ReDim Ay(s)
For j = 0 To UBound(Ar)
Ay(j) = Application.Small(Ar, j + 1) '排序
Next
ReDim Preserve C(k)
C(k) = Ay: s = 0: Erase Ay '加入資料到C陣列，把暫存陣列清除
k = k + 1
Next
[K1].Resize(k, UBound(A, 2) + UBound(B, 2)) = Application.Transpose(Application.Transpose(C))
End Sub

複製代碼

學海無涯_不恥下問

帖子: 77
主題: 11
精華: 0
積分: 118
點名: 0
作業系統: winXP
軟體版本: office2007
閱讀權限: 20
性別: 男
註冊時間: 2010-12-24
最後登錄: 2011-3-2

3^#

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

回復 2# Hsieh

Hsieh大大您好

我這次的重點落在『並將其餘相對應資料抄錄』，也就是第2維資料要跟著原來第1維資料

原先已有了兩個陣列(A、B)合併成C之後，第1維按由小而大順序，第2維須跟著原來的第1維
例如：
A陣列是A班的成績、姓名，B陣列是B班的成績、姓名
想要按照成績高低合併成新陣列，但成績須對到原來的人

感謝大大的回覆，
由其中我要學到處理工作表資料與陣列間的不同方式和想法

ASUS

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

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

4^#

發表於 2011-1-13 13:30 | 只看該作者

回復 3# asus103

不懂你所謂
並將其餘相對應資料抄錄
請上傳你的範例說明

學海無涯_不恥下問

帖子: 77
主題: 11
精華: 0
積分: 118
點名: 0
作業系統: winXP
軟體版本: office2007
閱讀權限: 20
性別: 男
註冊時間: 2010-12-24
最後登錄: 2011-3-2

5^#

發表於 2011-1-13 13:42 | 只看該作者

回復 4# Hsieh
Hsieh大大您好
對不起，是我辭不達意
附上範例檔
感謝您

Book1.rar (12.24 KB)

ASUS

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

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

6^#

發表於 2011-1-13 16:34 | 只看該作者

本帖最後由 Hsieh 於 2011-1-13 22:28 編輯

回復 5# asus103

Sub ex()
Dim C()
Open "test.txt" For Output As #1 '產生暫存檔
A = [B1:D2]: B = [F1:I2]
For i = LBound(A, 2) To UBound(A, 2)
Print #1, A(1, i) & "," & A(2, i)
Next
For i = LBound(B, 2) To UBound(B, 2)
Print #1, B(1, i) & "," & B(2, i)
Next
Close #1
Shell "sort / " & "test.txt" & " /o " & "temp.txt" '產生排序暫存檔
'偵測直到檔案產生,再繼續後面的動作
While Dir("temp.txt") = ""
Wend
Open "temp.txt" For Input As #1
Do Until EOF(1)
Line Input #1, mystr
ReDim Preserve C(s)
C(s) = Split(mystr, ",")
s = s + 1
Loop
Close #1
Kill "test.txt" '刪除暫存檔
Kill "temp.txt" '刪除排序暫存檔
[B12].Resize(2, s) = Application.Transpose(C)
End Sub

複製代碼

sort指令是Windows原本就有的DOS指令，用於排序純文字檔。
以上程式通過Windows7+Excel2010測試；
若在你的電腦執行有誤，請確認你的電腦裡有 sort.exe 這個執行檔。

學海無涯_不恥下問

帖子: 77
主題: 11
精華: 0
積分: 118
點名: 0
作業系統: winXP
軟體版本: office2007
閱讀權限: 20
性別: 男
註冊時間: 2010-12-24
最後登錄: 2011-3-2

7^#

發表於 2011-1-13 16:45 | 只看該作者

回復 6# Hsieh
感謝您Hsieh大大
我測試過了winxp、office2007能正常工作
跟文字檔間的互動是我之前比較少碰，但正好是我自己規劃下一階段的學習目標
我需要多花一點時間去研究他，若有問題再向您請教
感謝您

ASUS

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

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

8^#

發表於 2011-1-13 17:39 | 只看該作者

本帖最後由 Hsieh 於 2011-1-13 18:45 編輯

回復 7# asus103

Sub yy() '氣泡排序
Dim Ar(), Ay()
A = [B1:D2]: B = [F1:I2]
For Each y In Array(A, B)
For i = LBound(y, 2) To UBound(y, 2)
ReDim Preserve Ar(s)
ReDim Preserve Ay(s)
Ar(s) = y(1, i)
Ay(s) = y(2, i)
s = s + 1
Next
Next
For i = 0 To UBound(Ar)
For j = 0 To UBound(Ar) - 1
If Ar(j + 1) < Ar(j) Then '遞增
'If Ar(j + 1) > Ar(j) Then '遞減
temp = Ar(j)
temp1 = Ay(j)
Ar(j) = Ar(j + 1)
Ar(j + 1) = temp
Ay(j) = Ay(j + 1)
Ay(j + 1) = temp1
End If
Next
Next
[B15].Resize(, s) = Ar
[B16].Resize(, s) = Ay
End Sub

複製代碼

學海無涯_不恥下問

帖子: 77
主題: 11
精華: 0
積分: 118
點名: 0
作業系統: winXP
軟體版本: office2007
閱讀權限: 20
性別: 男
註冊時間: 2010-12-24
最後登錄: 2011-3-2

9^#

發表於 2011-1-13 20:32 | 只看該作者

本帖最後由 asus103 於 2011-1-13 20:34 編輯

回復 8# Hsieh
感謝您Hsieh大大
又提供我另一個思考方式

可以另外再請教您有關"Delay"的用法嗎?
VBA說明我看不甚懂
不知道如何控制延遲時間，
如果在一回圈中每一次延遲0.5秒，其語法為何
謝謝

ASUS

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

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

10^#

發表於 2011-1-13 21:05 | 只看該作者

本帖最後由 Hsieh 於 2011-1-13 22:26 編輯

回復 9# asus103
一般模組

Declare Sub Sleep Lib "kernel32" (ByVal dwmilliseconds As Long) '宣告API的SLEEP函數
Sub nn()
t = Timer '開始計時
For i = 1 To 10
Sleep 500 '延遲500/1000秒
Next
MsgBox "延遲" & Timer - t & "秒" "每次延遲0.5秒，十次延遲後共延遲?秒
End Sub

複製代碼

學海無涯_不恥下問