- 帖子
- 2834
- 主題
- 10
- 精華
- 0
- 積分
- 2890
- 點名
- 0
- 作業系統
- 〔略〕
- 軟體版本
- 〔略〕
- 閱讀權限
- 100
- 性別
- 男
- 來自
- 〔略〕
- 註冊時間
- 2013-5-13
- 最後登錄
- 2024-11-22
|
26#
發表於 2015-8-28 12:23
| 只看該作者
光〔複製．貼上〕就要耗費大半天時間，尤其文字或公式更耗時，
使用陣列直接運算取出結果再貼入，因判斷值只有０及１，貼入時還算快，
雖是最基本的〔陣列．array〕運用，但對初學者也頗有難度，恕無法解說，參考即可：
 test01.rar (139.58 KB)
若資料太多，可能造成記憶體不足問題，試試看！
我只插花，此論壇各板主皆是專業高手，可請求其協助！
Sub 分析()
Dim Srr, Sht As Worksheet, Arr, Brr, Crr, X, Y, Z, R, TM
Dim i&, j&, k%, M, Mrr(1 To 2560, 1 To 2), S&, SU&
TM = Timer
R = [data!C65536].End(xlUp).Row
Arr = [Data!C1:D1].Resize(R)
X = [Data!I4]: If X < 2 Then X = 2
Y = [Data!J4]: If Y > R Then Y = R
Z = Y - X + 1: If Z <= 0 Then Exit Sub
ReDim Crr(X To Y, 1 To 256)
Application.ScreenUpdating = False
For i = 1 To 10
Set Sht = Sheets("析" & i)
Brr = Sht.Rows(1)
For k = 1 To 256
M = M + 1
For j = X To Y
If Brr(1, k) <= Arr(j, 1) And Brr(1, k) >= Arr(j, 2) Then S = 1
Crr(j, k) = S: SU = SU + S: S = 0
Next j
Mrr(M, 1) = Brr(1, k): Mrr(M, 2) = SU: SU = 0
Next k
Sht.UsedRange.Offset(1, 0).ClearContents
With Sht.[A2].Resize(Z, 256)
Sht.Rows(2).Copy .Cells
.Value = Crr
End With
Next i
Sheets("結果").[A3:B3].Resize(M) = Mrr
MsgBox Timer - TM
End Sub |
|
發表於 2015-8-28 10:03
| 
