[發問] 請各位前輩幫忙檢查此程式

1^# 跳轉到 » 倒序看帖

打印

字體大小: tT

發表於 2015-7-13 11:28 | 只看該作者

請各位高手協助確認此程式, 小弟我很菜

需求做一個map圖會在cell(100.2)執行出來用顏色區別

分成沒東西綠色黃色三種

但有時執行不會產生問題,有時執行會擋掉機率大約1/2

不知是否哪邊語法有提再感謝各位前輩指導程式碼如下

Sub 巨集1()
For j = 1 To 91
For i = 1 To 58
If Cells(j + 0, i + 0).Interior.ColorIndex = Cells(1, 1).Interior.ColorIndex Then
Cells(100, 2).Value = Cells(100, 2).Value & "." '沒東西顯示.
Else
If Cells(j, i).Interior.ColorIndex = Cells(1, 2).Interior.ColorIndex Then
Cells(100, 2).Value = Cells(100, 2).Value & "A" '綠色填上A
Else
Cells(100, 2).Value = Cells(100, 2).Value & "X" '黃色填上X
End If
End If
Next
Cells(100, 2).Value = Cells(100, 2).Value & Chr(10) '換行
Next
MsgBox "OK"
End Sub

複製代碼

test.zip (20.95 KB)

2^#

發表於 2015-7-13 11:30 | 只看該作者

修正一下,最後一句話打錯,不知是否哪邊語法有錯誤

2016猴年全勤獎章 2015羊年全勤獎章熱烈參與勳章

3^#

發表於 2015-7-13 14:29 | 只看該作者

回復 2# graysurf

應該是寫入Cells(100, 2)時，速度變慢的關係
可以改成下列代碼執行速度也會加快很多，試試看！

Sub 巨集1()
For j = 1 To 91
For i = 1 To 58
If Cells(j + 0, i + 0).Interior.ColorIndex = Cells(1, 1).Interior.ColorIndex Then
A = A & "."
ElseIf Cells(j, i).Interior.ColorIndex = Cells(1, 2).Interior.ColorIndex Then
A = A & "A"
Else
A = A & "X"
End If
Next
A = A & Chr(10)
Next
Cells(100, 2) = A
MsgBox "OK"
End Sub

複製代碼

靜思自在 : 【時間如鑽石】時間對一個有智慧的人而言，就如鑽石般珍貴；但對愚人來說，卻像是一把泥土，一點價值也沒有。