サイトスワップ掲示板

仕事中でも使えるサイトスワップ作成用エクセルマクロ

No.75: 2015-10-13(火) 00:01:04
投稿者: セバスちゃん
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim gyou As Long 'ダブルクリックしたセルの行番号を格納する
Dim retu As Long 'ダブルクリックしたセルの列番号を格納する。
Dim a As Long '
Dim nagasa As Long 'サイトスワップの長さ
Dim k As Long '
Dim ss As Long 'ダブルクリックした行と同じ列を下って最初の1が現れたかどうかの判定用
Dim i As Long '
Dim j As Long '
Dim ball_aru As Long 'ある行に1があるかどうかの判定用
Dim sss As Variant '
sss = Array("0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", "n", "o", "p", "q", "r", "s", "t", "u", "v", "w", "x", "y", "z")

gyou = Target.Row 'ダブルクリックしたセルの行番号を格納
retu = Target.Column 'ダブルクリックしたセルの列番号を格納
For i = 1 To 10000 '
If Cells(i, 1).Value <> "" Then
nagasa = i
End If
If nagasa < gyou Then
nagasa = gyou
End If
Next i
If gyou < 37 Then
Cells(gyou, retu).Value = 1 'ダブルクリックしたセルに1を書き込む
End If
For a = 1 To 36 'ダブルクリックした行の残りのセルに0を書き込む
If retu <> a Then
Cells(gyou, a).Value = 0
End If
Next af

For i = 1 To nagasa '37列目にサイトスワップを書き込むための処理
ball_aru = 0
For j = 1 To 36 '1列から36列までボールが存在する列についてそのボールのサイトスワップを調べていく
If Cells(i, j).Value = 1 Then 'ある列に1があった時、その列を長さ分検索して最初に1が現れるまでの長さをサイトスワップに変換して37列目に書き込む
ball_aru = 1
ss = 0
For k = i + 1 To nagasa '今判定中の行から最終行まで
If Cells(k, j).Value = 1 And ss = 0 Then
ss = 1
Cells(i, 37).Value = sss(k - i)
End If
Next k
For k = 1 To i '最初の行から今判定中の行まで
If Cells(k, j).Value = 1 And ss = 0 Then
ss = 1
Cells(i, 37).Value = sss(nagasa - i + k)
End If
Next k
End If
Next j
If ball_aru = 0 Then '判定中の行に1がなければ37列目にサイトスワップ「0」を書き込む
Cells(i, 37).Value = sss(0)
End If

Next i
Cells(1, 38).Value = "" '38列目の先頭行にサイトスワップ列を書き込む
For i = 1 To nagasa
Cells(1, 38).Value = Cells(1, 38).Value & Cells(i, 37).Value
Next i

End Sub

関連ツリー

【1】 仕事中でも使えるサイトスワップ作成用エクセルマクロ No.75 セバスちゃん 2015-10-13(火) 00:01:04
Re: 仕事中でも使えるサイトスワップ作成用エクセルマクロ No.76 セバスちゃん 2015-10-13(火) 00:03:30
Re^2: 仕事中でも使えるサイトスワップ作成用エクセルマクロ No.77 セバスちゃん 2015-10-13(火) 00:07:15
エクセルマクロ第2弾 No.84 セバスちゃん 2015-10-23(金) 23:19:09
使い方 No.85 セバスちゃん 2015-10-23(金) 23:25:00
Re: 仕事中でも使えるサイトスワップ作成用エクセルマクロ No.78 セバスちゃん 2015-10-13(火) 15:28:06
動きました! No.79 加藤 2015-10-17(土) 09:53:10

掲示板に戻る