以下、文字列から英字を抜き出すサンプルを頂戴しました。
Sub test()
Dim i, k As Long
Dim str, buf As String
For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
Cells(i, 3) = WorksheetFunction.Substitute _
(WorksheetFunction.Substitute(Cells(i, 1), "]", ""), "[", "")
For k = 1 To Len(Cells(i, 3))
str = Mid(Cells(i, 3), k, 1)
If str Like "[A-z,A-z]" Then
buf = buf & str
End If
If Len(buf) > 0 And Not str Like "[A-z,A-z, ]" Then Exit For
Next k
Cells(i, 2) = buf
buf = ""
Next i
Columns(3).ClearContents
End Sub
上記に以下の2つの機能を付け足したいです。
2文字以下の英字の時は英字がなかったものとして空白をかえしてほしい。→(1)
(例)身長が3cm伸びた田中君→空白
(例)身長が3cm伸びたXYZ君→XYZ
(例)こちらABC放送局→ABC
最初の一塊と後から出てくる一塊の長いほうをかえしてほしい。→(2)
(例)学期末TESTの成績はAAAです→TEST(前が長い)
(例)学期末TESTの成績はABCDです→TEST(同じ長さ)
(例)学期末TESTの成績はABCDEです→ABCDE(後が長い)
(1)と(2)を状況に応じて機能させたり停止したりしたいので
その部分のソースを明示して頂けましたら幸いです。
厚かましいお願いですが、何卒よろしくお願いいたします。
No.4ベストアンサー
- 回答日時:
No.3です!
続けてお邪魔します。
今回は(2)の方のコードになります。
今回もアルファベットの塊は二つとしています。
Sub test2()
Dim i, k As Long
Dim str, buf As String
For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
Cells(i, 3) = WorksheetFunction.Substitute(WorksheetFunction.Substitute _
(WorksheetFunction.Substitute(Cells(i, 1), " ", ""), "]", ""), "[", "")
For k = 1 To Len(Cells(i, 3))
str = Mid(Cells(i, 3), k, 1)
If str Like "[A-z,A-z]" Then
buf = buf & str
End If
If Len(buf) > 0 And Not str Like "[A-z,A-z]" Then Exit For
Next k
Cells(i, Columns.Count).End(xlToLeft).Offset(, 1) = buf
buf = ""
Next i
For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
Cells(i, 3) = WorksheetFunction.Substitute(Cells(i, 3), Cells(i, 4), "")
For k = 1 To Len(Cells(i, 3))
str = Mid(Cells(i, 3), k, 1)
If str Like "[A-z,A-z]" Then
buf = buf & str
End If
If Len(buf) > 0 And Not str Like "[A-z,A-z]" Then Exit For
Next k
Cells(i, Columns.Count).End(xlToLeft).Offset(, 1) = buf
buf = ""
If Len(Cells(i, 4)) >= Len(Cells(i, 5)) Then
Cells(i, 2) = Cells(i, 4)
Else
Cells(i, 2) = Cells(i, 5)
End If
Next i
Range("C:E").Delete
End Sub
以上、かなり強引なコードですが他に良い方法があればごめんなさいね。m(__)m
再三のご回答ありがとうございます。今後は自分でもこのようなVBが扱えるように時間を作って精進したいと思います。ご教示頂いたソースで作業が楽になり空いた時間に勉強したいと思いますので今後また困った時は宜しくお願い致します。
今回はまた遠方に戻る為に簡単なテストしか出来ませんでした。思った動作をしてくれませんでしたが、帰ってきたら試行錯誤しながら改造させて頂きたいと思います。ありがとうございました。
No.3
- 回答日時:
こんばんは!
前回投稿した者です。
乗りかかった船ですので、何とかご希望に添えれば良いのですが・・・
無理矢理って感じの方法です。
アルファベットの塊は二つだけとしています。
まず、(1)の場合の場合のコードです。
Sub test1()
Dim i, k As Long
Dim str, buf As String
For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
Cells(i, 3) = WorksheetFunction.Substitute(WorksheetFunction.Substitute _
(WorksheetFunction.Substitute(Cells(i, 1), " ", ""), "]", ""), "[", "")
For k = 1 To Len(Cells(i, 3))
str = Mid(Cells(i, 3), k, 1)
If str Like "[A-z,A-z]" Then
buf = buf & str
End If
If Len(buf) > 0 And Not str Like "[A-z,A-z]" Then Exit For
Next k
Cells(i, 2) = buf
buf = ""
Next i
For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
If Len(Cells(i, 2)) < 3 Then
Cells(i, 3) = WorksheetFunction.Substitute(Cells(i, 3), Cells(i, 2), "")
Cells(i, 2) = ""
For k = 1 To Len(Cells(i, 3))
str = Mid(Cells(i, 3), k, 1)
If str Like "[A-z,A-z]" Then
buf = buf & str
End If
If Len(buf) > 0 And Not str Like "[A-z,A-z]" Then Exit For
Next k
End If
Cells(i, 4) = buf
If Cells(i, 4) <> "" Then
Cells(i, 2) = Cells(i, 4)
End If
buf = ""
Next i
Range("C:D").Delete
End Sub
尚、(2)の場合のコードを載せると2000文字を超えそうなので
もう一度続けて投稿します。
まずはここまで・・・m(__)m
No.2
- 回答日時:
先ずは、頂かれたサンプルコードを理解する事が必要ではないでしょうか。
理解すれば(1)については直ぐに解が得られると思う、(2)についてソースの明示は
丸写しされるとご質問者の為になりませんからヒントを回答します。
>2文字以下の英字の時は英字がなかったものとして空白をかえしてほしい。
⇒「If Len(buf) > 0 ~」を変更、但し、英字単語が1つの場合のみに限る
>最初の一塊と後から出てくる一塊の長いほうをかえしてほしい。
⇒文字列の組立用と設定用の2つ分のエリアを持ち、組立用文字数が設定用文字数より
大の場合に組立用から設定用にコピーする様にする
この場合、前述の条件も併せた判定をすれば一石2鳥である事は言うまでもない
一身上の都合で遠方に月曜の晩から行っており、昨日戻って参りました。ご回答を頂戴致しましたのに長らくお返事できずに申し訳ございませんでした。
まったく仰る通りです。自分で勉強して書けるようになりたいですが、今回は頂戴したソースを使わせて頂きました。以後、時間が有る時には勉強して行きたいと思います。ありがとうございました。
No.1
- 回答日時:
(1)も(2)も質問のプログラムを解析し、アルファベットの塊が2つだったら簡単にできそう。
B1セルが出る
A1セルの文字列からB1セルの文字を置き換え、C1セルに代入する
C1セルからアルファベットを取り出す
文字の長さを比較してどちらかを採用する
最終結果が2文字以下なら消す
付加すれば(1)になる
一身上の都合で遠方に月曜の晩から行っており、昨日戻って参りました。ご回答を頂戴致しましたのに長らくお返事できずに申し訳ございませんでした。
ご説明して頂いた理屈は理解致しましたが脳が実際のコードを書く技量がございませんでした。今後は自分でもっと考えれるように勉強したいと思います。ありがとうございました。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) このマクロの説明文を教えてほしいです。 1 2023/01/12 09:17
- Visual Basic(VBA) VBAでfunctionを利用しようとしたときに「引数は省略できません」というエラーが出ます 1 2022/10/15 16:30
- Excel(エクセル) エクセルで同じ数字同士を自動で線で結ぶVBAを教えてください 6 2022/04/26 23:13
- Visual Basic(VBA) VBAで質問ですが、皆さんはどの様に導き出しているのでしょうか? 6 2022/05/03 21:53
- Excel(エクセル) 2つのVBAを一緒にしたら機能しなくなりました(エクセル) 7 2022/06/02 12:41
- Excel(エクセル) VBA フォルダ見える化のコードについて 2 2023/06/19 15:04
- Visual Basic(VBA) いつもお世話になっております、VBAで教えて頂きたいのですが 2 2022/05/05 22:20
- Visual Basic(VBA) Excel VBA キーワードから列を取得して、さらに空欄行を非表示にする 3 2022/10/21 22:49
- Visual Basic(VBA) 実行時エラー´5854´ 文字列型パラメーターが長すぎます。 3 2023/06/08 21:17
- Visual Basic(VBA) VBA 請求書自動作成 3 2022/04/24 01:58
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
IF関数で空欄("")の時、Null...
-
関数TRANSPOSEで空白セルを0に...
-
数式による空白を無視して最終...
-
Excelで"0"を空白に変換する方法
-
Excel:関数が入っているセルに...
-
空白セル内の数式を残したまま...
-
Excel > ピボットテーブル「(空...
-
OpenOfficeでのワイルドカード...
-
Excel 特定セルの数値を参照し...
-
エクセルで、「複数のセルの中...
-
vlookup にて、返す値が、空白...
-
VLOOK関数で作った請求書で、¥...
-
リンクされているセルを空白と...
-
エクセルで上の行の値を自動的...
-
エクセルで、合計をもとめたい...
-
エクセルの数式で教えてください。
-
時間の差し引き 元セルが空白セル
-
【EXCEL】空白でないセルの位置...
-
Excel関数 直近3回分の出庫平均...
-
列の複数ある空白セルを飛ばし...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
IF関数で空欄("")の時、Null...
-
数式による空白を無視して最終...
-
エクセルでCSVを編集するとき、...
-
ピボットテーブルで空白セルの...
-
excel2010 空白セルにのみ貼り...
-
Excel > ピボットテーブル「(空...
-
空白セル内の数式を残したまま...
-
「データ要素を線で結ぶ」がチ...
-
エクセルで、「複数のセルの中...
-
Excelで、入力文字の後に自動で...
-
エクセル 連番が途切れていると...
-
《Excel2000》SUMPRODUCT関数で...
-
SUMIFS関数で「計算式による空...
-
【Excel】 csvの作成時、空白セ...
-
形式貼り付けの「空白を無視す...
-
Excel:関数が入っているセルに...
-
リンク先が空白若しくはゼロの...
-
エクセルで上の行の値を自動的...
-
エクセルにて負の時間を0:00と...
-
エクセルのグラフで式や文字列...
おすすめ情報