Untitled
unknown
vbscript
2 years ago
6.4 kB
8
Indexable
Private Sub Worksheet_Change(ByVal Target As Range) With Target If (.Row = 5 Or .Row = 6 Or .Row = 9) And .Column = 4 Then Range("X6:AJ65536").ClearContents temp = 0 Read_Inf For MDF_num = 1 To 3 If Sheets("MDF").Cells(7, (MDF_num - 1) * 14 + 3) = "" Then Set mpdata = Sheets("MDF").Cells(6, (MDF_num - 1) * 14 + 2) Else Set mpdata = Sheets("MDF").Range(Sheets("MDF").Cells(6, (MDF_num - 1) * 14 + 2), Sheets("MDF").Cells(6, (MDF_num - 1) * 14 + 3).End(xlDown)) For i = 1 To mpdata.Rows.Count If i = 65530 Then 下一個年齡 = mpdata(i + 1, 4) 下二個年齡 = Sheets("MDF").Cells(6, MDF_num * 14 + 5) ElseIf i = 65531 Then 下一個年齡 = Sheets("MDF").Cells(6, MDF_num * 14 + 5) 下二個年齡 = Sheets("MDF").Cells(7, MDF_num * 14 + 5) Else 下一個年齡 = mpdata(i + 1, 4) 下二個年齡 = mpdata(i + 2, 4) End If If MDF_num > 1 And i = 1 Then 前一個年齡 = Sheets("MDF").Cells(6, (MDF_num - 2) * 14 + 5) Else 前一個年齡 = mpdata(i - 1, 4) End If If mpdata(i, 2) = Cells(5, 4) And (Left(Cells(9, 4), 1) + 0 = 6 Or Left(Cells(9, 4), 1) + 0 = mpdata(i, 7)) Then If Cells(6, 4) = "Total" Then Range(Cells(6 + temp, 24), Cells(6 + temp, 31)).Value = Sheets("MDF").Range(Sheets("MDF").Cells(5 + i, (MDF_num - 1) * 14 + 2), Sheets("MDF").Cells(5 + i, (MDF_num - 1) * 14 + 9)).Value For dis_num1 = 1 To 5 If Cells(6 + temp, 29) < dis_SA_inf(Cells(6 + temp, 24), Cells(6 + temp, 26), dis_num1 + 1) Or dis_SA_inf(Cells(6 + temp, 24), Cells(6 + temp, 26), dis_num1 + 1) = 0 Then Exit For End If Next dis_num1 Cells(6 + temp, 36) = dis_num1 temp = temp + 1 ElseIf Cells(6, 4) = "Key Age" Then If mpdata(i, 4) Mod 10 = 0 Or (i = 1 And MDF_num = 1) Or mpdata(i, 4) > 下一個年齡 Or mpdata(i, 4) < 前一個年齡 Then Range(Cells(6 + temp, 24), Cells(6 + temp, 31)).Value = Sheets("MDF").Range(Sheets("MDF").Cells(5 + i, (MDF_num - 1) * 14 + 2), Sheets("MDF").Cells(5 + i, (MDF_num - 1) * 14 + 9)).Value For dis_num1 = 1 To 5 If Cells(6 + temp, 29) < dis_SA_inf(Cells(6 + temp, 24), Cells(6 + temp, 26), dis_num1 + 1) Or dis_SA_inf(Cells(6 + temp, 24), Cells(6 + temp, 26), dis_num1 + 1) = 0 Then Exit For End If Next dis_num1 Cells(6 + temp, 36) = dis_num1 temp = temp + 1 End If AMP = AMP + mpdata(i, 8) If (Int((mpdata(i, 4) + 5) / 10) <> Int((下一個年齡 + 5) / 10) Or ((i = 1 Or mpdata(i, 4) < 前一個年齡) And mpdata(i, 4) Mod 10 > 4) Or (下一個年齡 > 下二個年齡 And (Int(下一個年齡 - 1) Mod 10 < 4))) Then Cells(5 + temp, 31) = max(AMP, 10 ^ -10) AMP = 0 End If End If End If Next i Next MDF_num End If If (.Row = 7 Or .Row = 8) And .Column = 8 Then If Sheets("Setup").Range("X7") = "" Then Set MP = Sheets("Setup").Range("X6:AE6") Else Set MP = Sheets("Setup").Range("X6", Sheets("Setup").Range("AE6").End(xlDown)) For i = 1 To MP.Rows.Count If Sheets("Setup").Cells(7, 8) = "Total" And Sheets("Setup").Cells(8, 8) = "Total" Then For k = 1 To 12 MP(i, k).Interior.Color = 13431551 Next k ElseIf Sheets("setup").Cells(7, 8) = "" Or Sheets("Setup").Cells(8, 8) = "" Then For k = 1 To 12 MP(i, k).Interior.Color = 14277081 Next k ElseIf Sheets("Setup").Cells(7, 8) <> "Total" And Sheets("Setup").Cells(8, 8) <> "Total" Then If Right(Sheets("setup").Cells(7, 8), 1) = "M" Then MF = 1 Else MF = 2 AGE = Left(Sheets("setup").Cells(7, 8), Len(Sheets("setup").Cells(7, 8)) - 1) + 0 If MP(i, 4) = AGE And MP(i, 5) = MF And MP(i, 3) = Sheets("Setup").Cells(8, 8) Then For k = 1 To 12 MP(i, k).Interior.Color = 13431551 Next k Else For k = 1 To 12 MP(i, k).Interior.Color = 14277081 Next k End If ElseIf Sheets("Setup").Cells(8, 8) = "Total" Then If Right(Sheets("setup").Cells(7, 8), 1) = "M" Then MF = 1 Else MF = 2 AGE = Left(Sheets("setup").Cells(7, 8), Len(Sheets("setup").Cells(7, 8)) - 1) + 0 If MP(i, 4) = AGE And MP(i, 5) = MF Then For k = 1 To 12 MP(i, k).Interior.Color = 13431551 Next k Else For k = 1 To 12 MP(i, k).Interior.Color = 14277081 Next k End If ElseIf Sheets("Setup").Cells(7, 8) = "Total" Then If MP(i, 3) = Sheets("Setup").Cells(8, 8) Then For k = 1 To 12 MP(i, k).Interior.Color = 13431551 Next k Else For k = 1 To 12 MP(i, k).Interior.Color = 14277081 Next k End If End If Next i End If End With End Sub Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink) End Sub Private Sub Worksheet_PivotTableBeforeAllocateChanges(ByVal TargetPivotTable As PivotTable, ByVal ValueChangeStart As Long, ByVal ValueChangeEnd As Long, Cancel As Boolean) End Sub
Editor is loading...
Leave a Comment