エクセル2003のVBAで質問です（当方初心者です）。

質問

エクセル2003のVBAで質問です（当方初心者です）。

セル内に入力した文字の一部を別のシートの指定したセルにコピーしたいのですが、上手くいきません。

例えば、
sheet1には
A1　猿2上野
A2　牛3旭山
A3　亀2横浜
と入力されていて、

sheet2では
A1　猿　　B1　2　　C3　上野
A2　牛　　B2　3　　C2　旭山
A3　亀　　B3　2　　C3　横浜

となるように入力したいのです。

コマンドボタンを押したときにそうなるようにしたいと考えています（コマンドボタンの使用などは上手くいっています。）

character関数などを用いても「このプロパティまたはメソッドをサポートしていない」と上手くいきません。

宜しくお願いいたします。

回答No.4

sample_

正規表現を使うと楽にできたりするのですが、正規表現自体難しいので参考までにコード及び説明をのせておきます。

Sub Sample()
   Dim Reg As Object, result As Object
   Set Reg = CreateObject("VBScript.RegExp")
   Reg.Pattern = "^(¥D+)(¥d+)(¥D+)$"

   Dim r As Integer
   For r = 1 To 3
       Set result = Reg.Execute(Cells(r, 1))
       Sheets("Sheet2").Cells(r, 1) = result(0).SubMatches(0)
       Sheets("Sheet2").Cells(r, 2) = result(0).SubMatches(1)
       Sheets("Sheet2").Cells(r, 3) = result(0).SubMatches(2)
   Next
End Sub

簡単な説明
２行目:Reg変数は、正規表現のオブジェクト作成用、resultは正規表現の結果を格納する用のオブジェクト
３行目：正規表現のオブジェクトを作成。
４行目：正規表現をセット。
　　　　先頭から数字じゃない文字が１つ以上続き、数字が１つ以上続き、数字じゃない文字が１つ以上続く場合にマッチする

６行目：For文で使う変数。現在の行数を格納
７行目：For文でA1,A2,A3を順にループして値を取得
８行目：正規表現を実行し、結果をresultに格納
９行目：正規表現「^(¥D+)(¥d+)(¥D+)$」の最初の括弧にあたる数字以外(¥D+)を取り出す(猿/牛/亀の部分)
10行目：正規表現「^(¥D+)(¥d+)(¥D+)$」の２番目の括弧にあたる数字(¥d+)を取り出す(2/3/2の部分)
11行目：正規表現「^(¥D+)(¥d+)(¥D+)$」の３番目の括弧にあたる数字以外(¥D+)を取り出す(上野/旭山/横浜の部分)

9行目～11行目は、シート２の各セルに代入しています。

正規表現は、むずかしいとよくいわれて敬遠されが使えるように
なるとすごい便利ですのであえてあげさせてもらいました　汗

回答No.3

layy

すべて入力し終わったあとでの操作案です。
入力すると同時にシート２に表示したいというのなら他の意見で。

「猿2上野」
に規則があればあるほど対応がやりやすくなりますが、例外があると厳しいです。

「猿2上野」の「猿」や「上野」に数値が存在しない
「猿2上野」の「2」に数値１ケタしか存在しない
ならば
「猿2上野」の「猿」「2」「上野」になればいいわけなので
「猿2上野」の「2」を「,2,」にすることで
「猿,2,上野」といった
カンマ区切りの形式ができそうです。

ＣＳＶ形式で保存して、
数値１０個分置換え、
ＣＳＶ形式を開く、
これだけです。

同等のことをＶＢＡでやっても構いません。

回答No.2

imogasi

A1　猿　　B1　2　　C3　上野
A2　牛　　B2　3　　C2　旭山
A3　亀　　B3　2　　C3　横浜
は
A1　猿　　B1　2　　C1　上野
A2　牛　　B2　3　　C2　旭山
A3　亀　　B3　2　　C3　横浜
の間違いだろう。
初心者と言うことで、正規表現を使うのは無理だろう。
１文字づつ判別して考えて行く。
また他シートへ出すのも少し勉強が要るので同一シートに出してみる。
これとて、ロジックのコントロールは慣れないとやや難しい。
例データ
A列
東京2横山 健一
横浜東23木村　進
靜岡山手234野村　順
ーーー
数字は半角であること
３部分は全データで揃っている、ものとして
ーーー
標準モジュールに
Sub test01()
d = Range("A65536").End(xlUp).Row
For i = 1 To d
s = Cells(i, "A")
'msgBox "L" & Len(s)
jyoutai = 1 '数字前状態
For k = 1 To Len(s)
Select Case jyoutai
Case 1
If IsNumeric(Mid(s, k, 1)) Then
Cells(i, "B") = Mid(s, 1, k - 1) '第1漢字部分
jyoutai = 2 '数字状態
numst = k
'MsgBox "F" & k
End If
Case 2
If Not (IsNumeric(Mid(s, k, 1))) Then
'MsgBox "T" & k
Cells(i, "C") = Mid(s, numst, k - numst) '数字部分
Cells(i, "D") = Mid(s, k, Len(s) - k + 1) '第2漢字部分
Exit For
End If
End Select
Next k
Next i
End Sub
結果B-D列
東京 2 横山 健一
横浜東 23 木村　進
靜岡山手 234 野村　順

回答No.1

zant

正規表現を使えばラクラク。

Public Sub Execute()
Dim hRegExp As Object
Dim hMatches As Object
Dim hSubMatches As Object
Dim hMatch As Object
Dim foo As String
Dim bar(2) As String
Dim i As Long

foo = ""

Set hRegExp = CreateObject("VbScript.Regexp")
hRegExp.Pattern = "^(.+)(\d)(.+$)"
hRegExp.IgnoreCase = True
hRegExp.Global = True

'Sheet1に入力された値を変数fooに取得します。
foo = Sheet1.Cells(1, 1).Text

Set hMatches = hRegExp.Execute(foo)
If hMatches.Count = 1 Then
Set hSubMatches = hMatches.Item(0).SubMatches
For i = 0 To hSubMatches.Count - 1
bar(i) = hSubMatches(i)
Next i
End If

'Sheet2に値を設定します。
Sheet2.Range("A1:C1").Value = bar
End Sub

参考URL：

http://codezine.jp/article/detail/1655