エクセルで将棋盤を再現したいと思い、VBAを1から学び始め1週間です。
SFEN形式というものを変換し、盤面を再現したいです。
例)
lnG4nl/5k3/p1p+R1g1p1/1p1p3sp/5N3/2P1p1p2/PP1GP3P/1SG2+p1+b1/LN1K4L/w/Srbs4p/60
【実現したいこと】
後手番となる相手の駒(先に”歩”や”金”などに変換したもの)を180度回転させて表示したいです。
よろしくお願いいたします。
コードを書き始めたばかりでとても見にくい物になっているかと思います。
書き方などもご教授いただけたら幸いです。
該当のソースコード
VBA
1Sub 空欄をスラッシュに変換() 2 Worksheets("SFEN").Range("A1").Replace " ", "/", xlPart 3End Sub 4 5Sub スラッシュで分ける() 6 Dim a, i As Variant 7 Dim j As Long 8 9 With ActiveSheet 10 'コンマ区切りで分割 11 a = Split(Worksheets("SFEN").Cells(1, 1), "/") 12 '配列の大きさの分だけループ 13 For i = 0 To UBound(a) 14 Worksheets("Sheet2").Cells(1, 1 + i) = a(i) 'セルへ入力 15 Next 16 End With 17End Sub 18Sub 駒に変換() 19 20 Worksheets("Sheet2").Range("A1:L1").Replace "+s", "全", xlPart, MatchCase:=True 21 Worksheets("Sheet2").Range("A1:L1").Replace "+p", "と", xlPart, MatchCase:=True 22 Worksheets("Sheet2").Range("A1:L1").Replace "+n", "圭", xlPart, MatchCase:=True 23 Worksheets("Sheet2").Range("A1:L1").Replace "+l", "杏", xlPart, MatchCase:=True 24 Worksheets("Sheet2").Range("A1:L1").Replace "+b", "馬", xlPart, MatchCase:=True 25 Worksheets("Sheet2").Range("A1:L1").Replace "+r", "竜", xlPart, MatchCase:=True 26 27 Worksheets("Sheet2").Range("A1:L1").Replace "s", "銀", xlPart, MatchCase:=True 28 Worksheets("Sheet2").Range("A1:L1").Replace "p", "歩", xlPart, MatchCase:=True 29 Worksheets("Sheet2").Range("A1:L1").Replace "n", "桂", xlPart, MatchCase:=True 30 Worksheets("Sheet2").Range("A1:L1").Replace "l", "香", xlPart, MatchCase:=True 31 Worksheets("Sheet2").Range("A1:L1").Replace "b", "角", xlPart, MatchCase:=True 32 Worksheets("Sheet2").Range("A1:L1").Replace "r", "飛", xlPart, MatchCase:=True 33 Worksheets("Sheet2").Range("A1:L1").Replace "k", "王", xlPart, MatchCase:=True 34 Worksheets("Sheet2").Range("A1:L1").Replace "g", "金", xlPart, MatchCase:=True 35 36End Sub 37 38Sub 横を縦に変換() 39 Dim i As Long, j As Long 40 Dim Ws1 As Worksheet 41 Dim Ws2 As Worksheet 42 Set Ws1 = Worksheets("Sheet2") 43 Set Ws2 = Worksheets("将棋盤") 44 For i = 1 To Ws1.Cells(Rows.Count, 1).End(xlUp).Row 45 For j = 1 To 9 46 Ws2.Cells(Rows.Count, 1).End(xlUp).Offset(1) _ 47 .Value = Ws1.Cells(i, j).Value 48 Next j 49 Next i 50Set Ws1 = Nothing: Set Ws2 = Nothing 51End Sub 52 53Sub 一文字ずつ区切る() 54 Dim str As String 55 Dim i As Long 56 Dim j As Long 57 58 Worksheets("将棋盤").Activate 59 ' セルB2を選択状態にする 60 For j = 2 To 10 61 Worksheets("将棋盤").Cells(j, 1).Select 62 63 With ActiveCell 64 str = .Value 65 For i = 1 To Len(str) 66 .Offset(0, i).Value = Mid(str, i, 1) 67'offset セルの移動 68'Mid("文字",文字の何番目,抜き出す文字数) 69 Next i 70 End With 71 Next j 72 73End Sub 74 75Sub 後手の回転(sheetName As String, targetStr As String, font As Long) 76 77 Dim targetStrLen As Integer 78 Dim r As Range 79 Dim index As Double 80 Dim fontObj As font 81 82 83 targetStrLen = Len(targetStr) 84 85 For Each r In Worksheets("将棋盤").UsedRange 86 87 index = 1 88 89 Do 90 index = InStr(index, r.Value, targetStr) 91 92 If (index <> 0) Then 93 Set fontObj = r.Characters(index, targetStrLen).font 94 With fontObj 95 .color = color '色を変更 96 .Bold = True '太くする ←この部分も変えたい @游ゴシックに変更→90度回転 97 End With 98 index = index + targetStrLen 99 Else 100 Exit Do 101 End If 102 103 Loop 104 105 Next 106 107 Set fontObj = Nothing 108 109End Sub 110
試したこと
文字を検索し、該当の文字だけ色を変えるというコードがあったので、それをもとに改良してみたのですが、うまく作動しませんでした。
よろしくお願いいたします。
回答2件
あなたの回答
tips
プレビュー
バッドをするには、ログインかつ
こちらの条件を満たす必要があります。
2021/09/21 07:35
2021/09/21 07:41 編集
2021/09/21 07:48
2021/09/22 02:16