No.7ベストアンサー
- 回答日時:
#6、cjです。
#6の補足欄見ました。
ご提示のコードを読み込んで、
「フラ盤」の棋譜データからサンプルを作り、
テストしました。
ご提示のコードで試したところ、
なんのストレスもなく、正しく動作することを確認しました。
現在のコードのままでもいいような気もしていますが、
冗長な感じが気になるのも理解できるところです。
今回の課題は「もっと簡単に」ということでしたから、
持駒の漢数字置換に関連した部分に限って、
簡単にする書き方を提示してみます。
その前にプロシージャの構成を整理しておきます。
■データ読込・整形
●棋譜ファイル
▲盤面
行位置の取得
盤面要素を 出力用フォーマットに置換
最下行位置取得
▲持駒
行位置の取得
タイトル削除
持駒DATAを配列化
持駒要素の漢数字を半角算用数字へ置換
▲指手
行位置の取得
最下行から 何手詰めか取得
指手配列を 手数分で再定義
指手要素を 出力用フォーマットに置換
■データ出力
●配置DATA
●持駒
●正解
ここで示すのは、▲持駒セクションの処理全体です。
構成を変えることで簡単にする可能性が増すので、
セクションごと提示します。
#6補足欄のコードでいうと、
ER = Range("A1").End(xlDown).Row
と
C = 1
の間をすべて入れ替えると動くように書いています。
' ' ・
' ' ・
' ' ・
' ' ER = Range("A1").End(xlDown).Row
' ' ■ ↓ ■
Const 漢数字1_9 = "一二三四五六七八九" ' 宣言部に転記してください
Dim arrS As Variant ' 宣言部に転記してください
' ' 持駒――――――――――――――――――――――――――――――
' ' 先手の持駒 行位置の取得
MB = Range("A:A").Find(What:="先手の持駒", LookAt:=xlPart).Row
' ' "先手の持駒:" タイトル削除
持駒DATA = Mid$(Cells(MB, "A"), 7)
' ' "十 "を基準に、単独の漢数字'十'を半角算用数字'10'に置換
持駒DATA = Trim$(Replace(持駒DATA & " ", "十 ", "10 "))
' ' 漢数字'十'を半角算用数字'1'に置換
持駒DATA = Replace(持駒DATA, "十", "1")
' ' 漢数字'一~九'を半角算用数字'1~9'に置換
For N = 1 To 9
' ' 見つかったものだけを置換する
If InStr(持駒DATA, Mid$(漢数字1_9, N, 1)) > 0 Then 持駒DATA = Replace(持駒DATA, Mid$(漢数字1_9, N, 1), CStr(N))
Next N
' ' Split()関数で持駒DATAを文字列配列に
arrS = Split(" " & 持駒DATA, " ")
' ' 出力用配列 [持駒] に転写
For 行 = 1 To UBound(arrS)
If Len(arrS(行)) = 1 Then arrS(行) = arrS(行) & "1"
持駒(行) = arrS(行)
Next 行
' ' ■ ↑ ■
' ' 指手――――――――――――――――――――――――――――――
' ' C = 1
' ' ・
' ' ・
' ' ・
切り分けてから置換より置換してから切り分ける方が効率いいです。
行位置の取得 の部分はFind メソッドを簡単に書いていますが、
この部分は、ご提示の方法そのままでもいいと思います。
Split()関数はVBAの中でもかなり優秀な関数なので採用しましたが、
Excel2000よりも前のバージョンには用意されていません。
ところどころ、正規表現を使うと簡潔にできる部分もあります。
将来的に検討してみるのもいいと思います。
セル範囲に配列を出力する方法として、
例えば、
v = Array("名前", Date, 980)
Range("A1").Resize(, 3).Value = v
のように配列まるごと出力することも可能です。
完結にまとめるには有力な手法ですから、
色々試してみるといいかも知れません。
以上、参考まで。
No.6
- 回答日時:
こんにちは。
お邪魔します。(#No.1補足欄を参考にさせて頂きます。)
サブルーチンにして書きました。
書式:
Sub MotiGomaPrintA(ByVal Source As String, ByVal Destination As Range, _
Optional ByVal ToRight As Boolean, _
Optional ByVal Delimiter As String = " ")
Source には
> sheet1のセルには、"先手の持駒:角二 金四 銀四 桂二 香三 歩十五"のように入ります。"角"以下が変動します。
"先手の持駒:角二 金四 銀四 桂二 香三 歩十五"のような文字列を指定します。
Destination には
> これをsheet2のセル1に「角2」、セル2に「金4」のように切り分けます。
(セル2はセル1の下なのか右なのかわかりませんが)
この場合の'セル1'、出力先の先頭セルを指すRange型オブジェクトを指定します、
ToRight は
省略するかFalseを指定すると、縦方向、
Trueを指定すると、横方向、
に、持駒を(最大7セル)列挙して出力します。
Delimiter には
各持駒の間にある区切り文字を指定します。
省略した場合は、全角|半角スペースが区切り文字となります。
※
"先手の持駒:"の部分、タイトルには、最後の文字として
全角|半角コロン[":"|":"]が使われていることが条件です。
例示(Re8148829サンプル)は
F1セルにある持駒テキストを
F2から下(最大7セル)に
持駒ごとに切り分けた内容を半角数字に置換して出力する例です。
各パラメーターの指定は実用に合わせて調整してください。
複数セルを対象にする場合は
Source、Destination、共にループさせる必要があります。
' ' ==============================
Sub Re8148829サンプル()
Call MotiGomaPrintA(Range("F1").Value, Range("F2"))
End Sub
Sub MotiGomaPrintA(ByVal Source As String, ByVal Destination As Range, _
Optional ByVal ToRight As Boolean, _
Optional ByVal Delimiter As String = " ")
Const 漢数字 = "一二三四五六七八九十"
Dim arrS
Dim sTmp As String
Dim nUB As Long, nBuf As Long, nNum As Long
Dim i As Long, nPos As Long
Source = StrConv(Source, vbNarrow)
Source = Mid$(Source, InStr(Source, ":") + 1)
If Source = "" Then Exit Sub
arrS = Split(Source, Delimiter)
nUB = UBound(arrS)
For i = 0 To nUB
sTmp = arrS(i)
If InStr(漢数字, Mid$(sTmp, 2, 1)) Then ' ●
nBuf = 0&
For nPos = 2& To Len(sTmp)
nNum = InStr(漢数字, Mid$(sTmp, nPos, 1)) ' ▲
If nNum Then nBuf = nBuf + nNum
Next nPos
If nBuf Then arrS(i) = Left$(sTmp, 1) & nBuf
End If
Next i
With Destination
If ToRight Then
.Resize(1, 7).Value = Empty
.Resize(1, nUB + 1).Value = arrS
Else
.Resize(7, 1).Value = Empty
.Resize(nUB + 1, 1).Value = Application.Transpose(arrS)
End If
End With
End Sub
' ' ==============================
もし、自作で乗り切りたいということでしたら、
コードまるごと見せてもらった方が話が早いです。
ただ、
各駒ごと、2文字めに漢数字があるならば、、、(●で示した所)
という条件分岐や、
一文字ずつ見ていって"一二三四五六七八九十"の中の
何番目にあるか、で数値化している処理、、、(▲で示した所)
など、部分的には参考になるかも知れません。
こちらの理解が至っていない気もするので、
もし違っていたら補足ください。
とりあえず、以上です。
この回答への補足
Option Explicit
Option Base 1
Sub DATA変換()
'
Sheets("棋譜ファイル").Select
'BR="棋譜ファイル"盤面の上枠行、ER="棋譜ファイル"の最下行、MB="棋譜ファイル"の先手の持駒行
Dim 行 As Byte, 列 As Byte, BR As Byte, ER As Integer, SR As Integer, EC As Integer, C As Integer, N As Integer, 枡(40) As Variant, MB As Byte, 持駒DATA As Variant, 持駒(7) As Variant, 指手() As Variant
For 行 = 1 To Range("A1").End(xlDown).Row
If Left(Cells(行, "A"), 1) = "+" Then BR = 行: Exit For
Next 行
N = 1
For 行 = BR + 1 To BR + 9
For 列 = 2 To 18 Step 2
If Mid(Cells(行, "A"), 列, 2) <> " ・" Then
枡(N) = CStr(行 - BR) & CStr(列 / 2) & Mid(Cells(行, "A"), 列, 2)
枡(N) = Replace(枡(N), " ", "先")
枡(N) = Replace(枡(N), "v", "後")
枡(N) = Replace(枡(N), "杏", "成香")
枡(N) = Replace(枡(N), "圭", "成桂")
枡(N) = Replace(枡(N), "全", "成銀")
N = N + 1
End If
Next 列
Next 行
ER = Range("A1").End(xlDown).Row
For 行 = 1 To ER
If Left(Cells(行, "A"), 5) = "先手の持駒" Then MB = 行: Exit For
Next 行
持駒DATA = Replace(Cells(MB, "A"), "先手の持駒:", "")
For 行 = 1 To 7
If InStr(持駒DATA, " ") <> 0 Then
持駒(行) = Left(持駒DATA, InStr(持駒DATA, " ") - 1)
持駒DATA = Mid(持駒DATA, InStr(持駒DATA, " ") + 1)
ElseIf InStr(持駒DATA, " ") = 0 Then
持駒(行) = 持駒DATA: Exit For
End If
Next 行
For 行 = 1 To 7
If 持駒(行) = "" Then Exit For
持駒(行) = Replace(持駒(行), "十一", 11)
持駒(行) = Replace(持駒(行), "十二", 12)
持駒(行) = Replace(持駒(行), "十三", 13)
持駒(行) = Replace(持駒(行), "十四", 14)
持駒(行) = Replace(持駒(行), "十五", 15)
持駒(行) = Replace(持駒(行), "十六", 16)
持駒(行) = Replace(持駒(行), "十七", 17)
持駒(行) = Replace(持駒(行), "十八", 18)
持駒(行) = Replace(持駒(行), "一", 1)
持駒(行) = Replace(持駒(行), "二", 2)
持駒(行) = Replace(持駒(行), "三", 3)
持駒(行) = Replace(持駒(行), "四", 4)
持駒(行) = Replace(持駒(行), "五", 5)
持駒(行) = Replace(持駒(行), "六", 6)
持駒(行) = Replace(持駒(行), "七", 7)
持駒(行) = Replace(持駒(行), "八", 8)
持駒(行) = Replace(持駒(行), "九", 9)
持駒(行) = Replace(持駒(行), "十", 10)
If Len(持駒(行)) = 1 Then 持駒(行) = 持駒(行) & 1
Next 行
C = 1
For 行 = 1 To ER
If Cells(行, "A") = "手数----指手---------消費時間--" Then SR = 行: Exit For
Next 行
EC = Val(Mid(Cells(ER, "A"), 3))
ReDim 指手(EC)
For 行 = SR + 1 To SR + EC
指手(C) = Mid(Cells(行, "A"), 6)
指手(C) = Replace(指手(C), " ", "")
指手(C) = Replace(指手(C), " ", "")
指手(C) = Replace(指手(C), "打", "")
指手(C) = Left(指手(C), InStrRev(指手(C), "(") - 1)
指手(C) = Replace(指手(C), "(", "")
指手(C) = Replace(指手(C), ")", "")
If Left(指手(C), 1) = "同" Then 指手(C) = Left(指手(C - 1), 2) & Mid(指手(C), 2)
指手(C) = Switch(Mid(指手(C), 2, 1) = "一", 1, Mid(指手(C), 2, 1) = "二", 2, Mid(指手(C), 2, 1) = "三", 3, Mid(指手(C), 2, 1) = "四", 4, Mid(指手(C), 2, 1) = "五", 5, Mid(指手(C), 2, 1) = "六", 6, _
Mid(指手(C), 2, 1) = "七", 7, Mid(指手(C), 2, 1) = "八", 8, Mid(指手(C), 2, 1) = "九", 9) & Switch(Left(指手(C), 1) = 1, 1, Left(指手(C), 1) = 2, 2, Left(指手(C), 1) = 3, 3, Left(指手(C), 1) = 4, 4, _
Left(指手(C), 1) = 5, 5, Left(指手(C), 1) = 6, 6, Left(指手(C), 1) = 7, 7, Left(指手(C), 1) = 8, 8, Left(指手(C), 1) = 9, 9) & Mid(指手(C), 3)
C = C + 1
Next 行
Sheets("配置DATA").Select
列 = 1
For N = 1 To 1000
If Cells(N, "A") = "" Then 行 = N: Exit For
Next N
For N = 1 To 40
If 枡(N) = "" Then Exit For
Cells(行, 列) = 枡(N): 列 = 列 + 1
Next N
Sheets("持駒").Select
列 = 1
For N = 1 To 1000
If Cells(N, "A") = "" Then 行 = N: Exit For
Next N
For N = 1 To 7
If 枡(N) = "" Then Cells(行, "A") = "なし": Exit For
Cells(行, 列) = 持駒(N): 列 = 列 + 1
Next N
Sheets("正解").Select
列 = 1
For N = 1 To 1000
If Cells(N, "A") = "" Then 行 = N: Exit For
Next N
For 列 = 1 To EC
Cells(行, 列) = 指手(列)
Next 列
'
End Sub
詰将棋問題1問を駒配置sheet、持駒sheet、正解sheetの各1行に転記しています。
No.5
- 回答日時:
> このように切り分けてありますが、Cellsを持駒(行)に変えればいいのでしょうか
Sheet1の内容をSheet2に貼り付けてください。
そして、ANo.4のマクロを走らせると、Sheet2上の漢数字を全て半角数字に変換します。
その後で切り分ければよいかと思います。
回答いただきましてありがとうございます。
For 行 = 1 To 7
If 持駒(行) = "" Then Exit For
持駒(行) = Replace(持駒(行), "十一", 11)
持駒(行) = Replace(持駒(行), "十二", 12)
持駒(行) = Replace(持駒(行), "十三", 13)
持駒(行) = Replace(持駒(行), "十四", 14)
持駒(行) = Replace(持駒(行), "十五", 15)
持駒(行) = Replace(持駒(行), "十六", 16)
持駒(行) = Replace(持駒(行), "十七", 17)
持駒(行) = Replace(持駒(行), "十八", 18)
持駒(行) = Replace(持駒(行), "一", 1)
持駒(行) = Replace(持駒(行), "二", 2)
持駒(行) = Replace(持駒(行), "三", 3)
持駒(行) = Replace(持駒(行), "四", 4)
持駒(行) = Replace(持駒(行), "五", 5)
持駒(行) = Replace(持駒(行), "六", 6)
持駒(行) = Replace(持駒(行), "七", 7)
持駒(行) = Replace(持駒(行), "八", 8)
持駒(行) = Replace(持駒(行), "九", 9)
持駒(行) = Replace(持駒(行), "十", 10)
If Len(持駒(行)) = 1 Then 持駒(行) = 持駒(行) & 1
Next 行
切り分けてから上のように変換して転記していました。
No.4
- 回答日時:
ごめんなさい、No.3の回答では十の時1になってしまいますね。
やはり18回のReplaceが良いと思います。
Sub Sample2()
Sheets("Sheet2").Select
For i = 18 To 1 Step -1
Cells.Replace What:=Evaluate("NUMBERSTRING(" & i & ", 1)"), Replacement:=CStr(i)
Next i
End Sub
この回答への補足
持駒DATA=Replace(Cells(MB, "A"),"先手の持駒:","")
For 行 = 1 To 7
If InStr(持駒DATA," ") <> 0 Then
持駒(行)=Left(持駒DATA,InStr(持駒DATA," ")-1)
持駒DATA=Mid(持駒DATA,InStr(持駒DATA," ")+1)
ElseIf InStr(持駒DATA," ") = 0 Then
持駒(行) = 持駒DATA: Exit For
End If
Next 行
このように切り分けてありますが、Cellsを持駒(行)に変えればいいのでしょうか。
No.3
- 回答日時:
ANo.2です。
No.1の方への補足を観ました。
Sheet2全体を対象とするならReplaceを使う事になると思いますが、以下の様にすれば合計10回のReplaceで済みます。
Sub Sample()
Sheets("Sheet2").Select
For i = 1 To 10
Cells.Replace What:=Evaluate("NUMBERSTRING(" & i & ", 1)"), Replacement:=Left(CStr(i), 1)
Next i
End Sub
No.2
- 回答日時:
セル関数NUMBERSTRINGを使用してみました。
一~十八以外は0が返ります。Sub test()
MsgBox fNumberK("十八")
End Sub
Function fNumberK(sKnum As String) As Long
fNumberK = 0
For i = 1 To 18
If sKnum = Evaluate("NUMBERSTRING(" & i & ", 1)") Then
fNumberK = i
Exit Function
End If
Next i
End Function
No.1
- 回答日時:
一から十八までの漢数字がセルに単体で入っているのでしたら、漢数字のセルを一括選択して以下を実行するというのはいかがでしょうか。
Sub Test()
Dim splA, splB, rng, r
Const A = "一,二,三,四,五,六,七,八,九,十,十一,十二,十三,十四,十五,十六,十七,十八"
Const B = "1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18"
splA = Split(A, ",")
splB = Split(B, ",")
For Each rng In Selection
For r = 0 To UBound(splA)
If rng.Value = splA(r) Then Exit For
Next
rng.Value = splB(r)
Next
End Sub
この回答への補足
sheet1のセルには、"先手の持駒:角二 金四 銀四 桂二 香三 歩十五"のように入ります。"角"以下が変動します。
これをsheet2のセル1に「角2」、セル2に「金4」のように切り分けます。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- デスクトップパソコン 40年間の悩み キーボードにおいて初期値として漢字ローマ字変換に設定する方法 8 2023/05/08 14:50
- その他(Microsoft Office) WordやExcelで英数字のみ半角または全角にしたい 6 2022/08/03 08:18
- Access(アクセス) Accessのテキストボックスの入力文字制限 1 2023/01/18 20:43
- Visual Basic(VBA) 特定の文字を簡単な操作で半角スペースに変換するか削除したい 2 2022/11/01 10:35
- Visual Basic(VBA) EXCEL VBAで教えてください。 1 2022/12/22 04:20
- Visual Basic(VBA) VBA 「,」・空白・カタカナ等の複数条件のマクロ 2 2023/08/23 11:57
- Excel(エクセル) EXCELでの文字・数字入力の基本について教えてください。 2 2023/05/29 23:17
- Excel(エクセル) エクセルシート中の全角英数字を半角に変換したい 4 2022/07/07 13:14
- Visual Basic(VBA) エクセルの数式で教えてください。 1 2023/07/31 15:49
- その他(プログラミング・Web制作) 文章中の数値を自動で足すサービスはあるでしょうか? 1 2022/10/16 08:10
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
エクセルで文字の入力がセルの...
-
多数の計算セルに一括で同一の...
-
Excelからテキストへのコ...
-
excelで可視セルのみ置換
-
Excelのmatch関数エラー原因が...
-
置換機能を使わずに先頭に「'」...
-
エクセルのセルの中の,よりも前...
-
Excelの入力済みセルに一括で、...
-
【エクセル】ピボットテーブル...
-
Excelで、半角スペースをTABに...
-
Excelの空文字セルの削除方法を...
-
小数点を消す方法
-
Excelのシートにある1行...
-
エクセルでスペースの記号を表...
-
Excelで電話番号などの-(ハイ...
-
エクセルでセル内の一部を一括...
-
excelからメモ帳への貼り付け
-
Excel "~区"のみを削除したい
-
企業名簿で(株)や(有)を無視し...
-
エクセルでセルを文字列設定し...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
多数の計算セルに一括で同一の...
-
エクセルで文字の入力がセルの...
-
Excelのmatch関数エラー原因が...
-
Excelからテキストへのコ...
-
エクセルのセルの中の,よりも前...
-
excelで可視セルのみ置換
-
Excelの空文字セルの削除方法を...
-
置換機能を使わずに先頭に「'」...
-
Excelの入力済みセルに一括で、...
-
小数点を消す方法
-
Excelのシートにある1行...
-
エクセルでセル内の一部を一括...
-
【エクセル】ピボットテーブル...
-
エクセルの表ををメモ帳などに...
-
エクセルでセル内の一部分だけ...
-
Excelで電話番号などの-(ハイ...
-
Excelで、半角スペースをTABに...
-
一括でダブルクリックした状態...
-
エクセルの関数で、記号などを...
-
Excelのアポストロフィーの削除
おすすめ情報