Board logo

標題: 請老師指導如何將程序縮減? [打印本頁]
作者: jonn0510    時間: 2012-1-1 23:33     標題: 請老師指導如何將程序縮減?

請教各位老師:
下列程序是以 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.不知道能否再縮短程序呢?

因為小弟的權限不夠下載,能否將程序描述在網頁上.謝謝
作者: register313    時間: 2012-1-2 00:29

回復 1# jonn0510
初學者VBA
  1. Sub ZZ()
  2. Set rng = [F1:K1]
  3. For C = 14 To 64
  4.   Range(Cells(3, C), Cells(8, C)).Clear
  5.   Cells(3, C) = 0
  6.   For r = 11 To 15
  7.     If Application.CountIf(rng, Cells(r, C)) >= 1 Then
  8.        Cells(r - 7, C) = 1
  9.        Cells(3, C) = Cells(3, C) + 1
  10.     End If
  11.   Next r
  12. Next C
  13. End Sub
複製代碼
作者: GBKEE    時間: 2012-1-2 07:57

回復 1# jonn0510
  1. Sub Ex()
  2.     Dim Rng(1 To 2) As Range, E As Range
  3.     Set Rng(1) = [F1:K1]
  4.     Set Rng(2) = Range("N11").CurrentRegion
  5.     Rng(2)(1).Offset(-8).Resize(Rng(2).Rows.Count + 1, Rng(2).Columns.Count) = ""
  6.     For Each E In Rng(2)
  7.         If Application.CountIf(Rng(1), E) >= 1 Then
  8.             E.Offset(-7) = 1
  9.             Cells(Rng(2)(1).Row - 8, E.Column) = Cells(Rng(2)(1).Row - 8, E.Column) + 1
  10.         End If
  11.     Next
  12. End Sub
複製代碼
作者: jonn0510    時間: 2012-1-2 21:02

回復 2# register313

register313老師:
感謝您的指導,原來是這樣處理,其實 n4~n8 是小弟因為不知道如何讓下列程序執行後

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

在 n3 的位置加總,所以才使用變通的方式,程式分析完後,再加總.不然正常來說只需顯示 n3 的結果即可.不過還是感謝您的指點.非常謝謝.
作者: jonn0510    時間: 2012-1-2 21:21

回復 3# GBKEE

GBKEE 老師:
您的方式,小弟需要花些時間研究一下,不過好像可以自行延伸到 IV 的位置.
如 剛剛回覆 register313 老師,一樣

其實 n4~n8 是小弟因為不知道如何讓下列程序執行後
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
在 n3 的位置加總,所以才使用變通的方式,程式分析完後,再加總.不然正常來說只需顯示 n3 的結果即可.

另外可以自行延伸到 IV 的位置.能不能設定到 CN 這各位置. 謝謝您.
作者: GBKEE    時間: 2012-1-3 08:32

本帖最後由 GBKEE 於 2012-1-4 21:36 編輯

回復 5# jonn0510
另外可以自行延伸到 IV 的位置.能不能設定到 CN 這各位置
CurrentRegion 屬性 傳回 Range 物件，該物件代表目前的區域。目前區域是指以任意空白列及空白欄的組合為邊界的範圍。唯讀
如資料有從IV延伸到CN      使用CurrentRegion 可達成的
作者: jonn0510    時間: 2012-1-4 20:12

回復 6# GBKEE


GBKEE 老師:
嗯!我去翻書研究一下,不太能理解.
不過還是謝謝您.



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)