| |
こんにちは。かみちゃん です。
> 新たに問題が出てきて困っています。
新たな問題が出てくる前の質問の例であれば、Hirofumiさんのコードでうまくできているのでしょうか？
少なくとも、その報告は必要かと思います。
新たな問題の例を含めて、サンプルシートを整理すると以下のような感じなのでしょうか？
A B C D
1 (Table. 2)
2
3 (1) Aa (5A, 10) bb (25B, 30).
4
5 1) Nn (35A) pp (45).
6 2) Zz (46A, 47) za (48).
7 (b) Gg hh iii j.
8
9 (Table. 3)
10 (a) Kkk (70A) mm (75, 80).
11
12 (Table. 2B)
13 (a) Jjj(80A) nn (85, 90).
14
15 (Table. 22, 22A, 22B)
16
17 (1) Bb (6A, 20) cc (35B, 40).
18
19 1) Oo (45A) qq (55).
20 2) Yy (56A, 57) ya (58).
21 (b) Kk Ll mmm n.
22
23 (Table. 50)
24 (510, 515; Table. 84L)
25 (100, 105A; Table. 90, 90A)
26
> 列Aに(Table. 20B)の様にアルファベットを使用しているケースや
> (Table. 22, 22A, 22B)の様に複数テーブルがあるケースも同様に
については、Hirofumiさんのコードを以下のように修正するとできます。
Dim strProm As String
Dim k As Long '★追加
'結果出力の先頭セル位置を基準とする
Set rngResult = Worksheets("Sheet3").Range("A1")
' 〜省略〜
'転記するA列に書き込む元の文字列に登録
' vntNumber = vntData(1, 1)
vntNumber = Split(Mid(Left(vntData(1, 1), Len(vntData(1, 1)) - 1), InStr(1, vntData(1, 1), cstrKey, _
vbBinaryCompare) + Len(cstrKey)), ",") '★修正
' 〜省略〜
For k = 0 To UBound(vntNumber) '★追加
'出力範囲に
With rngResult
' 〜省略〜
'Table番号を出力
' .Cells(lngRow, 1).Resize.Resize(UBound(vntResult) + 1).Value _
= Val(Mid(vntNumber, InStr(1, vntNumber, cstrKey, _
vbBinaryCompare) + Len(cstrKey)))
.Cells(lngRow, 1).Resize.Resize(UBound(vntResult) + 1).Value _
= Trim(vntNumber(k)) '★修正
End With
lngRow = lngRow + UBound(vntResult) + 1
Next k '★追加
' 〜省略〜
※マクロ初心者さんからのコメントもお待ちしています。
なのはさんと違う方ならば・・・ですが。
余計な詮索ですが、万が一、同一人であれば、お名前変えなくてもよかったと思います。
回答者も事情がある場合がありますので、そういう場合は、なのはさんが
「他の方でもいいのでどなたか教えてください」と言っていただければ、
時間があって、向学心のある誰かがフォローします。
ただ、後出し要件追加は、あまり好ましくありません。
|
|
かみちゃん
- 10/9/2(木) 8:59 -
