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

graysurf

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

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

分成沒東西  綠色  黃色 三種

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

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

1. Sub 巨集1()
   
2. For j = 1 To 91
   
3. For i = 1 To 58
   
4. If Cells(j + 0, i + 0).Interior.ColorIndex = Cells(1, 1).Interior.ColorIndex Then
   
5. Cells(100, 2).Value = Cells(100, 2).Value & "." '沒東西顯示.
   
6. Else
   
7. If Cells(j, i).Interior.ColorIndex = Cells(1, 2).Interior.ColorIndex Then
   
8. Cells(100, 2).Value = Cells(100, 2).Value & "A" '綠色填上A
   
9. Else
   
10. Cells(100, 2).Value = Cells(100, 2).Value & "X" '黃色填上X
    
11. End If
    
12. End If
    
13. Next
    
14. Cells(100, 2).Value = Cells(100, 2).Value & Chr(10) '換行
    
15. Next
    
16. MsgBox "OK"
    
17. End Sub

複製代碼

graysurf

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

lpk187

回復 2# graysurf


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

1. Sub 巨集1()
   
2. For j = 1 To 91
   
3.     For i = 1 To 58
   
4.     If Cells(j + 0, i + 0).Interior.ColorIndex = Cells(1, 1).Interior.ColorIndex Then
   
5.         A = A & "."
   
6.     ElseIf Cells(j, i).Interior.ColorIndex = Cells(1, 2).Interior.ColorIndex Then
   
7.         A = A & "A"
   
8.     Else
   
9.         A = A & "X"
   
10.     End If
    
11.     Next
    
12.     A = A & Chr(10)
    
13. Next
    
14. Cells(100, 2) = A
    
15. MsgBox "OK"
    
16. End Sub

複製代碼