標題:
依條件選對應值
[打印本頁]
作者:
yeh6712
時間:
2014-4-8 23:03
標題:
依條件選對應值
如圖,如何在第1個工作表中,輸入仰臥起坐的次數,程式會根據C欄的男、女,
來判斷要找第2個工作表中的那一個對照表,再把相對應的分數,填在E欄中…感謝…
[attach]17959[/attach]
[attach]17960[/attach]
作者:
GBKEE
時間:
2014-4-9 06:58
回復
1#
yeh6712
Option Explicit
Sub Ex()
Dim i As Integer, M As Variant, S As Integer, Rng As Range
i = 2
With Sheets("成績總表")
Do While .Cells(i, "C") <> ""
S = 0 '不是男女
If .Cells(i, "C") = "男" Then
S = 1 'A欄
ElseIf .Cells(i, "C") = "女" Then
S = 4 'D欄
End If
If S > 0 And .Cells(i, "D") > 0 Then '條件: 有欄位 且 仰臥起坐次數 > 0
If .Cells(i, "D") < Sheets("仰臥起坐").Columns(S).Cells(2, 1) Then
M = Application.Match(.Cells(i, "D"), Sheets("仰臥起坐").Columns(S), 0)
ElseIf .Cells(i, "D") >= Sheets("仰臥起坐").Columns(S).Cells(2, 1) Then
M = 2 '100分
End If
If IsNumeric(M) Then .Cells(i, "E") = Sheets("仰臥起坐").Columns(S).Cells(M, 2)
'Application.Match 工作表的函數:沒有找到時傳回 錯誤值
End If
i = i + 1
Loop
End With
End Sub
複製代碼
作者:
yen956
時間:
2014-4-9 13:08
本帖最後由 yen956 於 2014-4-9 13:14 編輯
回復
1#
yeh6712
1. 工作表 "仰臥起坐", (第2列)插入一列, 並各填 100,
這樣, 男生超過60次, 女生超過45次才能抓到分數
2. 定義名稱:
x=仰臥起坐!$A$2:$A$63
y=仰臥起坐!$D$2:$D$47
如下圖:
3. 工作表 "成績總表" , E2 公式:
=IF(C2="男",INDIRECT("仰臥起坐!B"&IF(C2="男",MATCH(D2,x,-1)+1,MATCH(D2,y,-1)+1)),INDIRECT("仰臥起坐!E"&IF(C2="男",MATCH(D2,x,-1)+1,MATCH(D2,y,-1)+1)))
向下拉
請參考!!
註:原附圖, 女生45次, 應為100分, 你誤填為男生的95分,
害我以為公式有問題, 查了半天才發現問題所在.
作者:
yeh6712
時間:
2014-4-9 18:16
回復
3#
yen956
不好意思原圖有誤…感謝您
作者:
yeh6712
時間:
2014-4-9 18:17
本帖最後由 yeh6712 於 2014-4-9 18:23 編輯
回復
2#
GBKEE
感謝大大的程式…了解…謝謝…!
目前是輸入次數後,再執行程式,才可顯示分數…
可否在輸入單筆次數後即顯示相對應的分數…?
作者:
yen956
時間:
2014-4-9 18:53
回復
5#
yeh6712
抱歉, 考慮久周, 修正公式如下:
=IF($D2="","",IF($C2="男",INDIRECT("仰臥起坐!B"&IF($C2="男",MATCH($D2,x,-1)+1,MATCH($D2,y,-1)+1)),INDIRECT("仰臥起坐!E"&IF($C2="男",MATCH($D2,x,-1)+1,MATCH($D2,y,-1)+1))))
向下拉, 多拉一點沒關係
試過了, 應該沒問題
作者:
yeh6712
時間:
2014-4-9 18:59
本帖最後由 yeh6712 於 2014-4-9 19:09 編輯
回復
6#
yen956
感謝您快速的回答…
新公式OK了…謝謝…!
作者:
GBKEE
時間:
2014-4-9 20:41
回復
5#
yeh6712
Option Explicit
'成績總表 工作表模組: 工作表上儲存格有修改的預設程式
Private Sub Worksheet_Change(ByVal Target As Range) 'Target變數->工作表上有改變值的儲存格
Dim Rng As Range, S As Integer, T As Range
If Target.Column = 3 Or Target.Column = 4 Then 'C欄 或 D欄
Set T = Cells(Target.Row, "D") 'D欄
If (Cells(Target.Row, "C") = "男" Or Cells(Target.Row, "C") = "女") And IsNumeric(T) Then
With Sheets("仰臥起坐")
If Cells(Target.Row, "C") = "男" Then
Set Rng = .Range("A2:A" & .[A2].End(xlDown).Row)
Else
Set Rng = .Range("D2:D" & .[D2].End(xlDown).Row)
End If
End With
If T >= Rng.Cells(1) Then
T.Cells(1, 2) = Rng.Cells(1, 2)
ElseIf T < Rng.Cells(1) And T > 0 Then
S = Rng.Cells(1) - T
T.Cells(1, 2) = Rng.Cells(S + 1, 2)
Else
T.Cells(1, 2) = "" 'E欄
End If
Else
If T.Row > 1 Then T.Cells(1, 2) = "" ' E欄 列數>1
End If
End If
End Sub
複製代碼
作者:
yeh6712
時間:
2014-4-9 22:30
本帖最後由 yeh6712 於 2014-4-9 22:37 編輯
回復
8#
GBKEE
感謝…了解了…:)
工作表上儲存格有修改的預設程式→是不是儲存格必須有手動輸入才算,
預先用公式寫好,再自動算出來的就不算儲存格有修改過,是嗎?
例: 預設C1=A1+B1 ,A1輸入2 , B1輸入3 ,則C1自動算出5
這時,儲存格C1就不算是有修改過嗎?
作者:
GBKEE
時間:
2014-4-10 06:16
本帖最後由 GBKEE 於 2014-4-10 06:17 編輯
回復
9#
yeh6712
例: 預設C1=A1+B1 ,A1輸入2 , B1輸入3 ,則C1自動算出5
這時,儲存格C1就不算是有修改過嗎
公式值的改變用重算事件
Private Sub Worksheet_Calculate()
MsgBox "A"
End Sub
複製代碼
還有許多 工作表的觸動事件程序可用
[attach]17967[/attach]
作者:
yeh6712
時間:
2014-4-11 15:55
回復
10#
GBKEE
預先寫好F欄的公式,並拉至F16,再於D、E欄輸入次數,F欄自動算出平均次數,
但並不會觸發G欄的分數…重算事件的程序要加在VBA的那裡?如何寫?謝謝您…
[attach]17983[/attach]
[attach]17984[/attach]
作者:
GBKEE
時間:
2014-4-11 17:09
回復
11#
yeh6712
詳看 10# 的圖示
重算事件 ,Change 事件 需二擇一執行,
Option Explicit
Private Sub Worksheet_Calculate()
Dim i As Integer, M As Variant, S As Integer, Rng As Range
i = 2
Do While Cells(i, "F").Formula <> "" '有公式
S = 0 '不是男女
If Cells(i, "C") = "男" Then
S = 1 'A欄
ElseIf Cells(i, "C") = "女" Then
S = 4 'D欄
End If
If S > 0 And Cells(i, "F") > 0 Then
If Cells(i, "F") < Sheets("仰臥起坐").Columns(S).Cells(2, 1) Then
M = Application.Match(Cells(i, "F"), Sheets("仰臥起坐").Columns(S), 0)
ElseIf Cells(i, "F") >= Sheets("仰臥起坐").Columns(S).Cells(2, 1) Then
M = 2 '100分
End If
If IsNumeric(M) Then Cells(i, "G") = Sheets("仰臥起坐").Columns(S).Cells(M, 2)
'Application.Match 工作表的函數:沒有找到時傳回 錯誤值
Else
Cells(i, "G") = ""
End If
i = i + 1
Loop
End Sub
複製代碼
歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)