エクセルの I1~L1 千 百 十 一 と 各列の位名が入力されています。
その下 I2~L2710に 0~9までの数字が、ランダムで入力してあります。
千百十一
3365
8592
1111
4488
4101
1176
3350
7256
1698
5866
7622
・・・・
・・・・
・・・・
....2710行
検索開始対象数字は I12 ~ L12 、上の表でみるなら < 7 6 2 2 > に あたります。
この数字を位別(列)に見て検索し、右列 M12 ~ U12 に < 何個前に対象数字があるか?> を位別に表記したいのです。
これを、2720行まで行います。
検索をするにあたり
①. 遡るのは10個前までです。各位の検査結果は
千 → M12 , 百 → O12 , 十 → Q12 , 一 → S12 に入力し、無ければ "X" とします。
②.①で "X" だった場合 各 M,O,Q,S の右隣の列(N,P,R,U)に、下の順番で検索
千の場合 千 → 百 → 十 → 一
百の場合 百 → 十 → 一 → 千
十の場合 十 → 一 → 千 → 百
一の場合 一 → 千 → 百 → 十
を行い、<どの位置(千・百・十・一)の何個前に該当数字はあたるのか?>を表記します。
③. 2を行い、検索しても無い場合は "X" と表記します。
※この7622の場合は、
千の位にある"7"は、3個前にあるので → M12→"3", N12→"X"
百の位にある"6"は、2個前にあるので→ O12→"2", P12→”X”
十の位にある"2"は、10個遡ってもありません。
なので右隣の一の位へ…。すると一の位の9個前にあるので → Q12→”X" , R12→”一,9”
一の位にある"2"は、9個前にあるので → S12→"9" , T12→"X"
となる表を作成したいのです。
※(千・百・十・一)の表記が難しい場合(あ・い・う・え)でも構いません。
調べ記載したい行が、I12~から始まりL2710まで、、、約3000行弱の数字を一個づつ調べるのは大変で、とても困っています。
良い方法は、無いでしょうか???
何卒、お力をお貸しください!!
よろしくお願いいたします。
No.3ベストアンサー
- 回答日時:
No.1です、
> 各列に無い場合②の作業を行う指定を"本文"のやり方から"補足コメント"記載のように変更したいのです。
その様にしたつもりなのですが……仕様について理解しきれていないのかもしれません。
> " 7622 " の十の位の場合は、一番近いのが、百の位の三回前にあたりますので→ Q12→”X" , R12→”百,3”と表記したいです。
となっていませんか?
私の理解に間違いがあるかもしれませんので、
質問欄に提示していただいたデータで、具体的に実行結果がこうなっているけど、こうして欲しいという様にご提示いただけないでしょうか?
No.2
- 回答日時:
以下でどうなりますか
提示されたデータはナンバーズの様ですが、
VBA での処理サンプルだということで・・・
なお、同列10行前まで見つからなかった場合、
直近に見つかったものを表示していますが、
添付図赤印の様に、直近の場合は10行のリミットを外してました
リミット判別する際には ★ 部分変更してください
Public Sub Samp1()
Dim dic(1 To 4) As Object, dicN As Object
Dim vA As Variant, vB As Variant, v As Variant
Dim i As Long, j As Long, k As Long, n As Long
Set dicN = CreateObject("Scripting.Dictionary")
With Range("I1", Cells(Rows.Count, "I").End(xlUp))
vA = .Resize(, 4).Value
End With
ReDim vB(1 To UBound(vA) - 11, 1 To 8)
For j = 1 To 4
Set dic(j) = CreateObject("Scripting.Dictionary")
Next
k = 2
While (k < 12)
For j = 4 To 1 Step -1
dic(j)(vA(k, j)) = k
dicN(vA(k, j)) = Array(j, k)
Next
k = k + 1
Wend
For i = k To UBound(vA)
For j = 1 To 4
n = (j - 1) * 2 + 1
k = dic(j)(vA(i, j))
If (i - k <= 10) Then
vB(i - 11, n) = i - k
vB(i - 11, n + 1) = "×"
Else
vB(i - 11, n) = "×"
v = dicN(vA(i, j))
If (IsArray(v)) Then
vB(i - 11, n + 1) = _
vA(1, v(0)) & "," & i - v(1) ' ★
Else
vB(i - 11, n + 1) = "×"
End If
End If
Next
For j = 4 To 1 Step -1
dic(j)(vA(i, j)) = i
dicN(vA(i, j)) = Array(j, i)
Next
Next
With Range("M12").Resize(UBound(vB), 8)
.Value = vB
End With
Set dicN = Nothing
For j = 1 To 4
Set dic(j) = Nothing
Next
End Sub
上記では、各列に出現したものの最新行番号を更新し覚える様にしてました
それ用に Dictionary を用いたわけですが、実際 I:L 列の値は何でも良いです
0 ~ 9 の値ではなく、A, B, C ・・・ でも
数値に限定するのなら Dictionary ではなく、配列でも・・・
以下は配列を使った例になるか?・・・
Public Sub Samp2()
Dim iA(1 To 4, 0 To 9) As Long
Dim iB(0 To 9, 1 To 2) As Long
Dim vA As Variant, vB As Variant
Dim i As Long, j As Long, k As Long, n As Long
With Range("I1", Cells(Rows.Count, "I").End(xlUp))
vA = .Resize(, 4).Value
End With
ReDim vB(1 To UBound(vA) - 11, 1 To 8)
k = 2
While (k < 12)
For j = 4 To 1 Step -1
iA(j, vA(k, j)) = k
iB(vA(k, j), 1) = j
iB(vA(k, j), 2) = k
Next
k = k + 1
Wend
For i = k To UBound(vA)
For j = 1 To 4
n = (j - 1) * 2 + 1
k = iA(j, vA(i, j))
If (i - k <= 10) Then
vB(i - 11, n) = i - k
vB(i - 11, n + 1) = "×"
Else
vB(i - 11, n) = "×"
If ((iB(vA(i, j), 1) > 0) _
And (iB(vA(i, j), 2) > 0)) Then
vB(i - 11, n + 1) = _
vA(1, iB(vA(i, j), 1)) & "," _
& i - iB(vA(i, j), 2)
Else
vB(i - 11, n + 1) = "×"
End If
End If
Next
For j = 4 To 1 Step -1
iA(j, vA(i, j)) = i
iB(vA(i, j), 1) = j
iB(vA(i, j), 2) = i
Next
Next
With Range("M12").Resize(UBound(vB), 8)
.Value = vB
End With
End Sub
※ L2710までに限定するなら
> With Range("I1", Cells(Rows.Count, "I").End(xlUp))
↓
With Range("I1").Resize(2710)
にしてみてください
No.1
- 回答日時:
こんな感じでしょうか?
動作に勘違いがありましたらスミマセン。
Sub test()
Dim cRng As Range
Dim dRng As Range
Dim rOffst As Long
Dim col As Long
Dim s As String
Dim notFound As String: notFound = "X"
For Each cRng In Range("I2:L2710") '確認範囲
' 結果を書くセル
Set dRng = Cells(cRng.row, 13 + 2 * (cRng.Column - 9))
' 同じ列を検索
rOffst = searchRow(cRng.Value, cRng)
If rOffst <> 0 Then
'同じ列に見つかった場合
dRng.Value = -1 * rOffst
dRng.offset(0, 1).Value = notFound
Else
dRng.Value = notFound
' I列 to L列のcRngと異なる列を検索
For col = 9 To 12 ' I列 to L列
If col = cRng.Column Then GoTo L_CONTINUE
rOffst = searchRow(cRng.Value, Cells(cRng.row, col))
If rOffst <> 0 Then
s = Cells(1, col).Value & "," & (-1 * rOffst)
dRng.offset(0, 1).Value = s
Exit For
End If
dRng.offset(0, 1).Value = notFound
L_CONTINUE:
Next col
End If
Next cRng
MsgBox "end"
End Sub
' baseから10個前までに同じ値があれば、そのrow offsetを返す。
' なければ 0を返す。
Function searchRow(val As Long, base As Range) As Long
Dim i As Long
searchRow = 0
For i = -1 To -10 Step -1
If base.row + i = 1 Then
Exit For
End If
If CLng(base.offset(i, 0).Value) = val Then
searchRow = i
Exit Function
End If
Next
End Function
お知恵を貸していただき有難うございます!!
バッチリ!本文通りの動作確認いたしました!!
ただ、各列に無い場合②の作業を行う指定を"本文"のやり方から"補足コメント"記載のように変更したいのです。
勝手を申し上げ、大変恐縮ですが、②の作業を補足コメントのように変更できませんでしょうか?
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
関連するカテゴリからQ&Aを探す
おすすめ情報
- ・漫画をレンタルでお得に読める!
- ・街中で見かけて「グッときた人」の思い出
- ・「一気に最後まで読んだ」本、教えて下さい!
- ・幼稚園時代「何組」でしたか?
- ・激凹みから立ち直る方法
- ・1つだけ過去を変えられるとしたら?
- ・【あるあるbot連動企画】あるあるbotに投稿したけど採用されなかったあるある募集
- ・【あるあるbot連動企画】フォロワー20万人のアカウントであなたのあるあるを披露してみませんか?
- ・映画のエンドロール観る派?観ない派?
- ・海外旅行から帰ってきたら、まず何を食べる?
- ・誕生日にもらった意外なもの
- ・天使と悪魔選手権
- ・ちょっと先の未来クイズ第2問
- ・【大喜利】【投稿~9/7】 ロボットの住む世界で流行ってる罰ゲームとは?
- ・推しミネラルウォーターはありますか?
- ・都道府県穴埋めゲーム
- ・この人頭いいなと思ったエピソード
- ・準・究極の選択
- ・ゆるやかでぃべーと タイムマシンを破壊すべきか。
- ・歩いた自慢大会
- ・許せない心理テスト
- ・字面がカッコいい英単語
- ・これ何て呼びますか Part2
- ・人生で一番思い出に残ってる靴
- ・ゆるやかでぃべーと すべての高校生はアルバイトをするべきだ。
- ・初めて自分の家と他人の家が違う、と意識した時
- ・単二電池
- ・チョコミントアイス
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
B列の最終行までA列をオート...
-
Excelで、あるセルの値に応じて...
-
Worksheets メソッドは失敗しま...
-
vba 2つの条件が一致したら...
-
VBA 何かしら文字が入っていたら
-
IIF関数の使い方
-
VBAコンボボックスで選択した値...
-
VBAのFind関数で結合セルを検索...
-
【Excel VBA】 B列に特定の文字...
-
複数の列の値を結合して別の列...
-
VBAを使って検索したセルをコピ...
-
Cellsのかっこの中はどっちが行...
-
セルに値が入っていた時の処理
-
オートフィルタをマクロで作成...
-
文字列の結合を空白行まで実行
-
空白セルをとばして転記
-
Excel マクロ VBA 別シートのセ...
-
VBA A列にありB列にないものま...
-
Changeイベントでの複数セルの...
-
DataGridViewに空白がある場合...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
B列の最終行までA列をオート...
-
Worksheets メソッドは失敗しま...
-
Excelで、あるセルの値に応じて...
-
vba 2つの条件が一致したら...
-
Cellsのかっこの中はどっちが行...
-
URLのリンク切れをマクロを使っ...
-
文字列の結合を空白行まで実行
-
データグリッドビューの一番最...
-
【VBA】2つのシートの値を比較...
-
VBA 何かしら文字が入っていたら
-
IIF関数の使い方
-
VBAを使って検索したセルをコピ...
-
Changeイベントでの複数セルの...
-
VBAの構文 3列置きにコピーし...
-
VBAのFind関数で結合セルを検索...
-
【Excel VBA】 B列に特定の文字...
-
VBAで指定範囲内の空白セルを左...
-
VBAでのリスト不一致抽出について
-
セルに値が入っていた時の処理
-
VBAコンボボックスで選択した値...
おすすめ情報
該当数字が無い場合の 訂正をさせてください!!
該当数字が無い場合は、一回前→二回前→三回前・・・・と十回前まで遡り、
一回前 千 → 百 → 十 → 一
二回前 千 → 百 → 十 → 一
三回前 千 → 百 → 十 → 一 ・・・・
と、より近い所で該当する数字は<どの位,何回前>としたいのです。
なので " 7622 " の十の位の場合は、一番近いのが、百の位の三回前にあたりますので
→ Q12→”X" , R12→”百,3”と表記したいです。
また、同じ回に該当する数字が二個以上入っている場合は、優先順位を
千 → 百 → 十 → 一
として表記したいのです。