Untitled
unknown
vbscript
2 years ago
6.4 kB
9
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