- 帖子
- 38
- 主題
- 13
- 精華
- 0
- 積分
- 84
- 點名
- 0
- 作業系統
- WIN XP
- 軟體版本
- OFFICE 2003
- 閱讀權限
- 20
- 性別
- 男
- 註冊時間
- 2011-12-10
- 最後登錄
- 2021-7-18
  
|
請老師指導如何將程序縮減?
請教各位老師:
下列程序是以 F1~K1的任意數字為比對原始資料,N11~N15的任意數字若有與F1~K1的任意數字相同者,則分別在N3~N8顯示數字1 ,最後再加總於N1處.
Dim C%, r%, rng As Range
Set rng = [F1:K1]
For C = 14 To 14
For r = 11 To 11
If Application.CountIf(rng, Cells(r, C)) >= 1 Then
Cells(4, C) = 1: Exit For
End If
Next r
Next C
Set rng = [F1:K1]
For C = 14 To 14
For r = 12 To 12
If Application.CountIf(rng, Cells(r, C)) >= 1 Then
Cells(5, C) = 1: Exit For
End If
Next r
Next C
Set rng = [F1:K1]
For C = 14 To 14
For r = 13 To 13
If Application.CountIf(rng, Cells(r, C)) >= 1 Then
Cells(6, C) = 1: Exit For
End If
Next r
Next C
Set rng = [F1:K1]
For C = 14 To 14
For r = 14 To 14
If Application.CountIf(rng, Cells(r, C)) >= 1 Then
Cells(7, C) = 1: Exit For
End If
Next r
Next C
Set rng = [F1:K1]
For C = 14 To 14
For r = 15 To 15
If Application.CountIf(rng, Cells(r, C)) >= 1 Then
Cells(8, C) = 1: Exit For
End If
Next r
Next C
Range("N3").Select
ActiveCell.FormulaR1C1 = "=SUM(R[1]C:R[7]C)"
Range("N4").Select
----------------------------------------------------------------
問題一
希望改成下列這樣能縮短程序,卻發現不能累加.不知道該如何處理?
Dim C%, r%, rng As Range
Set rng = [F1:K1]
For C = 14 To 14
For r = 11 To 15 '這裡更改
If Application.CountIf(rng, Cells(r, C)) >= 1 Then
Cells(4, C) = 1: Exit For
End If
Next r
Next C
問題二
如果像附件N11~N16.O11~O16.P11~P16 等,若要延長至BL11~BL16.不知道能否再縮短程序呢?
因為小弟的權限不夠下載,能否將程序描述在網頁上.謝謝 |
-
-
XYZ.rar
(9.51 KB)
|
發表於 2012-1-1 23:33
| 
