エクセルでデータの編集

質問

A列に氏名が列記してあり、氏名の頭に数字（リーディングゼロなし、最大3桁）が付いています。例：下記

A
1山本太郎
2日本次郎
28鈴木花子
336小泉純一

これらの数字を削除してB列を作りたい。例：下記
B
山本太郎
日本次郎
鈴木花子
小泉純一

こつこつでなく、一発で編集できますか？

回答No.5

comv · ベストアンサー

こんばんは

私も1例

=REPLACE(A1,1,MAX(IF(ISNUMBER(MID(A1,ROW($1:$15),1)*1),ROW($1:$15),0)),)

配列数式なので確定は[Ctrl]+[Shift]を押したまま[Enter]です
（成功すると数式が　{}　で括られます）

入力後、必要行まで複写

お礼

有り難うございます。
できました、バッチリです。希望する「関数式一発」ですし、言うこと有りません。
経験のない関数が使ってあり、勉強、勉強です。
有り難うございました。

回答No.4

imogasi

関数式での解答。
数字は半角であるとします。（全角数字ならこの解答を
没にしてください。４桁以上数字があっても大丈夫。）
全角数字に直すと、長さが数字の数だけ多くなることを利用します。
以下は途中説明を入れています。
Ａ１：Ａ５
1山本太郎
2日本次郎
28鈴木花子
336小泉純一
2345桑田　茂次郎
－－－
Ｂ１セルに=JIS(A1)といれ以下複写。
１山本太郎
２日本次郎
２８鈴木花子
３３６小泉純一郎
２３４５桑田　茂次郎
と全角文字ばかりになります。
－－－－
Ｃ１セルに=LENB(B1)といれ下に複写します。
10
10
12
16
20
となります。
－－－－
Ｄ１に=LENB(A1)といれ下に複写します。
9
9
10
13
16
－－－－
Ｅ１に=C1-D1といれ下に複写します。
1
1
2
3
4
と数字の文字数が出ます。
－－－－
Ｆ１セルに=RIGHTB(A1,D1-E1)といれ下に複写します。
山本太郎
日本次郎
鈴木花子
小泉純一郎
桑田　茂次郎
となります。
－－－－
１つにまとめると
=RIGHTB(A1,2*LENB(A1)-(LENB(JIS(A1))))
（第1行目）となります。
これをＢ１に入れて、下へ複写してください。

回答No.3

noname#27115

'これでもOKかな？
'標準モジュールにこれを追加して、、、
'B1に =GetStr(A1)と入れ、 下にコピーしてください。

Public Function GetStr(pStr As String) As String
Dim i As Long
Dim buf As String

For i = 1 To Len(pStr)
If IsNumeric(Mid(pStr, i, 1)) = False Then
buf = buf & Mid(pStr, i, 1)
End If
Next i
GetStr = buf
End Function

回答No.2

misatoanna

セル A1 からデータが入っているとして、セル B1 に
=MID(A1,MAX(ISNUMBER((MID(ASC(A1),COLUMN(1:1),1))*1)*COLUMN(1:1))+1,10)
と入力して、下方にドラッグコピーしてみてください。

もし 先頭のデータセルが A4 の場合は、上式の A1 を A4 に、COLUMN(1:1)を
COLUMN(4:4) にします。
式内最後の 10 は、検査するセル中で最も長いデータの文字数以上にします。

お礼

有り難うございます。
適用してみたところ、A1の解がセルB1ではなく、B1:C3（が結合されたセル）に入ります。解そのものは正しい（A1の1山本太郎に対してB1が山本太郎）です。
そのB1:C3を下位へドラッグすると、2行づつ飛んで解が求まります。
小生の希望に近いのですが、もう少しです。調べてみますが、misatoannaさんもわかりましたら、もう一度ご登場願えませんでしょうか。すみません。

補足

大変失礼しました。もう一度念入りに実施したら、ほぼできました。
「ほぼ」といいますのは、氏名の頭の数字が1桁の場合はOKなのですが、2桁，3桁ですと、下1桁，下2桁が残ってしまいます。式のどこかを修正すればよいのでしょうが、小生にはわかりません。

回答No.1

noname#5584

Forループがネストした、かなり汚く読みにくいコードですが、一応、下記のプログラムで可能です。
( もっとよい方法があるかも・・・ )

Sub PickUpStringData()
Dim strTmp As String
Dim i As Long
Dim j As Long
Dim Pos As Long
Dim ChrCd As Long

With Application.ActiveSheet
For i = 1 To .UsedRange.Rows.Count
strTmp = "" & .Cells(i, 1).Value
If Len(strTmp) > 0 Then
For j = 1 To Len(strTmp)
ChrCd = Asc(Mid$(strTmp, j, 1))
If ChrCd < 48 Or ChrCd > 57 Then
Exit For
End If
Next j

.Cells(i, 2).Value = Mid$(strTmp, j)
End If
Next i
End With
End Sub

インデントは適宜修正してください。(汗