Application.ScreenUpdating = False
x = Target.CurrentRegion.Cells(1).Column + 6
y = Target.CurrentRegion.Cells(1).Row
Target.CurrentRegion.Copy
Cells(y, x).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Set Boss = Cells(1)
For Each c In Cells(y, x).CurrentRegion
If IsNumeric(c) And c < 0 Then
Set Boss = c
c = c * -1
Exit For
End If
Next
Dim B() As Range, CB As Integer
ReDim B(1): Set B(1) = Cells(Target.Row, Target.Column + 6): CB = 0: s = 0: BossHit = 0
Do
CB = CB + 1
Bom B(), CB, BossHit, Boss
Loop Until UBound(B) = 0
Set Boss = Nothing
e = 0
For Each c In Cells(y, x).CurrentRegion
If IsNumeric(c) And c > 0 Then e = e + c
Next
If e = 0 Then
With Target.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End If
Cells(Target.Row + 6, Target.Column) = e
Cells(Target.Row + 6, Target.Column + 6) = CB
Cells(Target.Row + 6, Target.Column + 12) = BossHit
Cancel = True
Application.ScreenUpdating = True
End Sub
コメントする
人が嫌がる発言や､喧嘩になるような発言はやめましょう。
ルールに違反する投稿は禁止されています。禁止行為が確認された場合､予告無く削除退会等の処理をさせて頂く事がありますので予めご了承ください。
※ 一部端末/ブラウザでは画像投稿機能は非対応です。
※ 投稿された画像は実際の画像とは色、向き、解像度が異なる可能性があります。
入力した内容をご確認ください。よろしければ「コメントする」ボタンを押してください。
投稿内容が不正です
入力した内容をご確認ください。
メールでコメントを投稿します
画像を添付してから、本文を変更せずに指定された宛先にメールを送信してください。
送信後は投稿完了のメールをご確認ください。