| |
ichinoseさん、ありがとうございました。
１００％理解できました。
今回の、質問で私は次の、三つのことを感じました。
１．瞬時にして、これだけのシュミレーターを作成されてしまうichinoseさんのスキル
は慣れているとはいえすごいなーと感心させられました。
私は、VBAはまったくの初心者ですが、大型コンピュータのアセンブラーという言語 で、SE、プログラマーの経験は２０年以上あり（歳がばれてしまう）ますが、
感心させられました。
２．このような教え方もあるのだということ。
単に、回答を与えるのではなく、実際にためさせてみるということはいいことだと思 います。少し苦労すれば、それだけ見につくし、今回の場合、知らない機能も覚えま した。（セルに振り仮名を振る機能はまったく使わないので、知りませんでした)
回答者の方々にもこのような回答の仕方もあることは参考になるのではと思います。
３．せっかく作ってもらったシュミレーターなのでこの掲示板を見た方は一度、試された らいかがかと思います。マクロを貼り付けるだけで動きます。
自分で入力したデータでも確認したいこともあると思われるので、ichinoseさんには
無断で、少し改造しました。すみません。
Option Explicit
'===============================================
Sub main()
Const セル範囲 = "a1:f5"
Dim f_value As Variant
Dim find_cell As Range
Dim ans As Long
ans = MsgBox("入力されているデータを使いますか", vbYesNo)
If ans = vbNo Then Call mk_sample
MsgBox "Find サンプルデータ作成 検索値は 「2」"
f_value = "2" '検索する値を入れる
MsgBox "Xlvaluesは、RangeのValueプロパティの値が検索対象"
Set find_cell = get_findcell(f_value, ActiveSheet.Range(セル範囲), xlValues, xlPart)
Do While Not find_cell Is Nothing
find_cell.Select
MsgBox "セルアドレス " & find_cell.Address & " ---セルの値 " & find_cell.Value
Set find_cell = get_findcell() '次の検索
Loop
MsgBox "xlFormulasは、RangeのFormulaプロパティの値が検索対象"
Set find_cell = get_findcell(f_value, ActiveSheet.Range(セル範囲), xlFormulas, xlPart)
Do While Not find_cell Is Nothing
find_cell.Select
MsgBox "セルアドレス " & find_cell.Address & " ---セルの値 " & find_cell.Value & " ----Formulaプロパティ= " & find_cell.Formula
Set find_cell = get_findcell() '次の検索
Loop
MsgBox "xlCommentsは、RangeのCommentのTextプロパティの値が検索対象"
Set find_cell = get_findcell(f_value, ActiveSheet.Range(セル範囲), xlComments, xlPart)
Do While Not find_cell Is Nothing
find_cell.Select
MsgBox "セルアドレス " & find_cell.Address & " ---セルの値 " & find_cell.Value & " ----コメント= " & find_cell.Comment.Text
Set find_cell = get_findcell() '次の検索
Loop
MsgBox "=========== 以上、xlValues,Xlformulas,Xlcommentsの違い"
'=============================================================================================
MsgBox "SearchOrder=xlByRowsの場合の検索順序 検索順序に注目"
Set find_cell = get_findcell(f_value, ActiveSheet.Range(セル範囲), xlValues, xlPart, xlByRows)
Do While Not find_cell Is Nothing
find_cell.Select
MsgBox "セルアドレス " & find_cell.Address & " ---セルの値 " & find_cell.Value
Set find_cell = get_findcell() '次の検索
Loop
MsgBox "SearchOrder=xlByColumnsの場合の検索順序 検索順序に注目"
Set find_cell = get_findcell(f_value, ActiveSheet.Range(セル範囲), xlValues, xlPart, xlByColumns)
Do While Not find_cell Is Nothing
find_cell.Select
MsgBox "セルアドレス " & find_cell.Address & " ---セルの値 " & find_cell.Value
Set find_cell = get_findcell() '次の検索
Loop
MsgBox "=========== 以上、xlByRows xlByColumnsの違い つまり、検索順序が行方向か列方向か"
'=====================================================
Range("A1").Select
MsgBox "Searchdirection=xlNext の場合の検索方向 順回り検索"
Set find_cell = get_findcell(f_value, ActiveSheet.Range(セル範囲), xlValues, xlPart, , xlNext)
Do While Not find_cell Is Nothing
find_cell.Select
MsgBox "セルアドレス " & find_cell.Address & " ---セルの値 " & find_cell.Value
Set find_cell = get_findcell() '次の検索
Loop
Range("A1").Select
MsgBox "Searchdirection=xlPrevious の場合の検索方向 逆回り検索"
Set find_cell = get_findcell(f_value, ActiveSheet.Range(セル範囲), xlValues, xlPart, , xlPrevious)
Do While Not find_cell Is Nothing
find_cell.Select
MsgBox "セルアドレス " & find_cell.Address & " ---セルの値 " & find_cell.Value
Set find_cell = get_findcell() '次の検索
Loop
MsgBox "=========== 以上、xlNext xlPreviousの違い つまり、指定セル範囲の検索方向を順方向か逆方向かの指定 "
End Sub
'===============================================
Sub mk_sample()
Dim rng As Range
With ActiveSheet
With .Range("a1:c5")
.Formula = "=int(rand()*5)+1"
.Value = .Value
End With
With Range("d1:f5")
.Formula = "=a1+countif($a$1:$c$5,a1)"
End With
With Range("a1:d2")
For Each rng In .Cells
With rng
.ClearComments
.AddComment
.Comment.Visible = True
.Comment.Text Text:="コメント" & .Address
.Comment.Visible = False
End With
Next
End With
End With
End Sub
'===============================================
Function get_findcell(Optional ByVal f_v As Variant = "", _
Optional ByVal rng As Range = Nothing, _
Optional ByVal alookin As XlFindLookIn = -4163, _
Optional ByVal alookat As XlLookAt = 1, _
Optional ByVal aso As XlSearchOrder = 1, _
Optional ByVal asd As XlSearchDirection = 1, _
Optional ByVal mc As Boolean = False, _
Optional ByVal mb As Boolean = True) As Range
'指定された値でセル範囲を検索し､該当するセルを取得する
'input : f_v 検索する値
' rng 検索する範囲
' alookin 検索対象 xlvalues,xlformulas,xlcomments
' alookat: :検索方法 1-完全一致 2-部分一致
' aso : 検索順序 1 行 2 列
' asd : 検索方向 1 Xlnext 2 XlPrevious
' mc : 大文字・小文字の区別 False しない True する
' mb : 半角と全角を区別 True する False しない
'output:get_findcell 見つかったセル(見つからなかったときはNothingが返る)
Static 検索範囲 As Range
Static 最初に見つかったセル As Range
Static 直前に見つかったセル As Range
Static 検索方向 As XlSearchDirection
If Not rng Is Nothing Then
Set 検索範囲 = rng
End If
If f_v <> "" Then
' Set get_findcell = 検索範囲.Find(f_v, 検索範囲.Cells(検索範囲.Rows.Count, 検索範囲.Columns.Count), alookin, alookat, aso, asd)
Set get_findcell = 検索範囲.Find(f_v, 検索範囲.Cells(検索範囲.Rows.Count, 検索範囲.Columns.Count), _
alookin, alookat, aso, asd, mc, mb)
If Not get_findcell Is Nothing Then
Set 最初に見つかったセル = get_findcell
Set 直前に見つかったセル = get_findcell
検索方向 = asd
End If
Else
If 検索方向 = xlNext Then
Set get_findcell = 検索範囲.FindNext(直前に見つかったセル)
Else
Set get_findcell = 検索範囲.FindPrevious(直前に見つかったセル)
End If
If get_findcell.Address = 最初に見つかったセル.Address Then
Set get_findcell = Nothing
Else
Set 直前に見つかったセル = get_findcell
End If
End If
End Function
一を聞いて（３個質問してた）いろいろ教えてもらいありがとうございました。
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
