マルシェル新規登録で5000円分当たる

Excel VBA 数字抽出について VBAについておしえてください 下記の条件のもと数字のみを抽出

解決済

  • 質問者：kazunoko1689
  • 質問日時：
  • 回答数：2件

Excel VBA 数字抽出について
VBAについておしえてください
下記の条件のもと数字のみを抽出して
表示を行いたいのですがプログラム方法を教えていただけないでしょうか

条件
Ｂ11-B15セルに下記のように記載がある

100V
1000V
2000V
100A
1000A

これをＤ11-D15セルに数字だけを抽出したい

※関数では出来るのは知っているのですがこちらの都合でプログラム対応としたいのでよろしくお願いいたします

通報する

この質問への回答は締め切られました。

質問の本文を隠す

A 回答 (2件)

参考程度に

No.1ベストアンサー

  • 回答者： tom04
  • 回答日時：

こんにちは！



色々やり方はあると思いますが、一例です。
VBAのコードにそのままワークシート関数を利用してもよいのですが、ループさせる方法です。

Sub Sample1()
Dim i As Long, k As Long, myStr As String
For i = 11 To 15 '//←11行目～15行目まで//
For k = 1 To Len(Cells(i, "B"))
If Mid(StrConv(Cells(i, "B"), vbNarrow), k, 1) Like "[0-9]" Then
myStr = myStr & Mid(Cells(i, "B"), k, 1)
Else
Exit For
End If
Next k
Cells(i, "D") = myStr
myStr = ""
Next i
End Sub

こんな感じではどうでしょうか？

※　全角数字にも対応できるようにしてみました。m(_ _)m
    • good
    • 0
    • 件
通報する
この回答へのお礼

理想通りになりました　お手数をおかけしました

通報する
お礼日時：2017/09/14 11:29

No.2

  • 回答者： d-q-t-p
  • 回答日時：

その条件なら



Dim r As Range
For Each r In Range("B11:B15")
r.Offset(, 2).Value = Val(r.Value)
Next r

でいいと思います。

> ※関数では出来るのは知っているのですが
数式が分かるならそれをプログラムに組み込むだけだと思いますが……
    • good
    • 0
    • 件
通報する

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう！

Q質問する（無料）

このQ&Aを見た人はこんなQ&Aも見ています

関連するQ&A

関連するカテゴリからQ&Aを探す

専門家回答数ランキング

専門家

※過去一週間分の回答数ランキングです。

Q質問する（無料）

他の専門家の回答をチェック

このQ&Aと関連する良く見られている質問

QExcel VBA 並び替えについて お手数をおかけします 下記条件のようなプログラムを作りたいので

Excel VBA 並び替えについて
お手数をおかけします
下記条件のようなプログラムを作りたいのですがご教授をお願いいたします

sheet1
A1 みかん
A2 りんご
B1 ブドウ
C1 メロン
D1 柿
D2 イチゴ
と記載されているのを
sheet2のB2から縦に並び替えたい
B2 みかん
B3 りんご
B4 ブドウ
B5 メロン
B6 柿
B7イチゴ

ご教授をお願いいたします

Aベストアンサー

No.3 追補

もちろん、以下でもいいです。

Sub 並び替え()
Dim 元行 As Long
Dim 元列 As Long
Dim 先行 As Long
先行 = 2
Sheets("Sheet1").Select
For 元列 = 1 To Cells(1, Columns.Count).End(xlToLeft).Column
For 元行 = 1 To Cells(Rows.Count, 元列).End(xlUp).Row
Sheets("Sheet2").Cells(先行, 2).Value = Cells(元行, 元列).Value
先行 = 先行 + 1
Next
Next
Sheets("Sheet2").Select
End Sub

他の回答も見る

QExcel関数で、文字を数字に変換させたいです。 if関数で、数字を文字で表示させることは出来ますが

Excel関数で、文字を数字に変換させたいです。
if関数で、数字を文字で表示させることは出来ますが、その逆はできるのでしょうか？
また、その列を数字の合計で出すことはできますか？

Aベストアンサー

>>例えば、非を１、定を0として表示させることはできますか？

=IF(A1="非",1,IF(A1="定",0,""))

他の回答も見る

QエクセルVBA（マクロ）で呼び出すプログラムを教えてください。

エクセルVBA（マクロ）を使って、

№ 氏 名 性 決定 第一 第二 第三
101 鈴木 男 D 10 9 11
102 佐藤 男 B 4 6 5
103 山口 女 A 1 2 3
104 長田 男 C 7 8
105 中村 男 D 10 11 9

上のようなデータが「事業所1」というシートに入っています。
『別のシートにDを選んだ人のうち、第一希望で10を選んだ人を呼び出す。』
呼び出すプログラムを終えて頂けると助かります。よろしｋお願い致します。

Aベストアンサー

抽出したデータを「抽出結果」というシートに貼りつけるとして。
こんな感じでしょうか。

Dim mySheet1 As Range
Dim mySheet2 As Range

Set mySheet1 = ActiveWorkbook.Worksheets("事業所1").Range("A1")
Set mySheet2 = ActiveWorkbook.Worksheets("抽出結果").Range("A1")

mySheet1.AutoFilter Field:=4, Criteria1:="D"　← Dを選んだ人
mySheet1.AutoFilter Field:=5, Criteria1:=10　← かつ 10 を選んだ人

mySheet2.Cells.Clear

mySheet1.CurrentRegion.SpecialCells(xlVisible).Copy mySheet2

他の回答も見る

QVBA 複数シートをひとつにまとめる方法について

VBA初心者です。

ブック内の複数シートを
ひとつにまとめる方法について

検索していて見つけた・・・・

Sub Sample()
Dim sWS As Worksheet 'データシート（コピー元）
Dim dWS As Worksheet '集約用シート（コピー先）

Set dWS = Worksheets("AllData")

'集約用シートの2行目以降を削除
dWS.UsedRange.Offset(1, 0).Clear

'各シートの2行目以降のデータを、集約用シートの末尾にコピー
For Each sWS In Worksheets
If sWS.Name <> dWS.Name Then
With sWS.UsedRange

'コピー元シートにデータが1件以上ある場合
If .Rows.Count > 1 Then
.Offset(1, 0).Resize(.Rows.Count - 1).Copy _
Destination:=dWS.Cells(Rows.Count, 1). _
End(xlUp).Offset(1, 0)
End If

End With
End If
Next sWS

'集計用シートをA列で並べ替え
dWS.UsedRange.Sort Key1:=Range("A1"), Header:=xlYes
End Sub

こちらのやり方でばっちりだったのですが
問題点がひとつだけ。

まとめたシートのみでOKなのですが
見出し行の上に工事名やら期間やらを入力する
3～4行を空けておきたいのです。

3～4行・・・・
任意の行数を空けて
その下にまとめる方法を
教えていただけないでしょうか？

よろしくお願いします。

VBA初心者です。

ブック内の複数シートを
ひとつにまとめる方法について

検索していて見つけた・・・・

Sub Sample()
Dim sWS As Worksheet 'データシート（コピー元）
Dim dWS As Worksheet '集約用シート（コピー先）

Set dWS = Worksheets("AllData")

'集約用シートの2行目以降を削除
dWS.UsedRange.Offset(1, 0).Clear

'各シートの2行目以降のデータを、集約用シートの末尾にコピー
For Each sWS In Worksheets
If sWS.Name <> dWS....続きを読む

Aベストアンサー

No.3・4です。

＞1行目のSub Sample1()を
＞Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
＞に置き換えるだけではダメでした。

ダメとは全く反応しない！というコトでしょうか？
もしかしてそのまま標準モジュールに記載していませんか？
そうだとすれば、「Workbookのイベントプロシージャ」でなければ動きません。
VBE画面の左側の下にある「This Workbook」をダブルクリックし、表示されたVBE画面上に

＞Sub Sample1()
を
＞Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
に変更してそのままコピー＆ペーストしてみてください。

※　もちろん「標準モジュール」のコードは不要なので消去します。m(_ _)m

他の回答も見る

QＭＳの“小さな親切、余計なお世話”

Excel 2013 を使用しています。
添付図上段において、セル F1 に(赤矢印の先に)何やら表示されているアイコン、セル内に入力された文字列を隠しています。其処にマウスポインタを乗せると[挿入オプション]と表示され、当該アイコンの右端に現れたナビスコマークをクリックすると、添付図下段に示すメニューが。

この邪魔臭いアイコンを隠す(永久に表示されなくする)ための設定手順を教えてください。
ちなみに、このアイコンはどういう場合に表示されるようになっているのでしょうか？

Aベストアンサー

2016のオプション画像で申し訳ない。

「コンテンツを貼り付けるときに［貼り付けオプション］ボタンを表示する」
このチェックを外す。

他の回答も見る

QVBAで名前検索と可視セル数値の別シート貼り付け

VBAに詳しい方、たすけてください。
Excel2010のVBAで下記のように動くプログラムを組んではいただけないでしょうか。

①ExcelのBook全体のＤ列をユーザーが入力した任意の文字で検索する(テ

キストボックスを表示する)
②検索結果の文字の１個下の行に入った数値の合計を、検索した時に入力した文字数と一緒に「計算結果」というシートに貼り付ける。
例：検索した名前が「たまねぎ」で、その名前がsheet1のＤ３にあったら４行目の可視セルに入った数値の合計と名前をシート「計算結果」に貼り付ける。

※sheet2のＤ７にも同名の「たまねぎ」があった場合、８行目の可視セルの合計を加算して、総計を返す。返す値はブック全体の名前検索結果の１つ下の行の可視セルの合計。

シート「計算結果」
Ａ１ Ｂ１
たまねぎ 合計(全シートのＤ列にたまねぎが入った行の、
１つ下の行の可視セルの合計)
貼り付けの際、Ａ１とＢ１に既に別の文字と数値が入っていた際は
次の空白の行Ａ２とＢ２に貼り付ける(空白のセルに貼り付ける)

VBAに詳しい方、たすけてください。
Excel2010のVBAで下記のように動くプログラムを組んではいただけないでしょうか。

①ExcelのBook全体のＤ列をユーザーが入力した任意の文字で検索する(テ

キストボックスを表示する)
②検索結果の文字の１個下の行に入った数値の合計を、検索した時に入力した文字数と一緒に「計算結果」というシートに貼り付ける。
例：検索した名前が「たまねぎ」で、その名前がsheet1のＤ３にあったら４行目の可視セルに入った数値の合計と名前をシート「計算結果」に貼り付ける。
...続きを読む

Aベストアンサー

続けてお邪魔します。

結局各シートのD列を検索し、D列に対象品名があればその1行下のK～BT列の数値を合計すれば良いのですね？
↓のコードにしてみてください。

Sub Sample2()
Dim k As Long, myRow As Long, myFlg As Boolean
Dim myStr As String, wS As Worksheet
Dim myRng As Range, myFound As Range, myFirst As Range
myStr = InputBox("検索品名を入力")
With Worksheets("計算結果")
myRow = .Cells(Rows.Count, "A").End(xlUp).Row + 1
For k = 1 To Worksheets.Count
If Worksheets(k).Name <> .Name Then
Set wS = Worksheets(k)
Set myFound = wS.Range("D:D").Find(what:=myStr, LookIn:=xlValues, lookat:=xlWhole)
If Not myFound Is Nothing Then
.Cells(myRow, "A") = myStr
myFlg = True
Set myFirst = myFound
GoTo 処理
Do
Set myFound = wS.Range("D:D").FindNext(after:=myFound)
If myFound.Address = myFirst.Address Then Exit Do
GoTo 処理
処理:
Set myRng = Range(wS.Cells(myFound.Row + 1, "K"), wS.Cells(myFound.Row + 1, "BT"))
With .Cells(myRow, "B")
.Value = .Value + WorksheetFunction.Sum(myRng)
End With
Loop
End If
End If
Next k
If myFlg = False Then
MsgBox "該当品目なし"
End If
End With
End Sub

今度はどうでしょうか？m(_ _)m

続けてお邪魔します。

結局各シートのD列を検索し、D列に対象品名があればその1行下のK～BT列の数値を合計すれば良いのですね？
↓のコードにしてみてください。

Sub Sample2()
Dim k As Long, myRow As Long, myFlg As Boolean
Dim myStr As String, wS As Worksheet
Dim myRng As Range, myFound As Range, myFirst As Range
myStr = InputBox("検索品名を入力")
With Worksheets("計算結果")
myRow = .Cells(Rows.Count, "A").End(xlUp).Row + 1
For k =...続きを読む

他の回答も見る

Qエクセル 関数 曜日

エクセルで月・水・金(不定期休みを除く）のみ10,000と入力されるようにしたいのですが、はたして可能でしょうか？

A列1行目から下にその月の1日からの日付
B列は=TEXT(A1,"AAA")を下にフィル
C列に数値を出したい(10,000)

E1:E10はその月の不定期休みの日付（曜日関係なく）を入れています。

IF関数とWEEKDAYでできるのでしょうか？
正解を教えてほしいです。
宜しくお願いします。

Aベストアンサー

こんにちは！

Ａ列のシリアル値を利用すれば大丈夫だと思います。

C1セルに
=IF((WEEKDAY(A1)<7)*(MOD(WEEKDAY(A1),2)=0)*(COUNTIF(E$1:E$10,A1)=0),10000,"")

としてフィルハンドルで下へコピー！

こんな感じではどうでしょうか？m(_ _)m

他の回答も見る

Qエクセルで見えないが、何かがまだは言っているのを取りのぞくにはどうすればいい。

教えてください。

エクセルのA1に「〇○錠　1.5錠」、A2に「〇○錠　3錠」としてある場合。
「〇○錠　　　　　」とだけするために、1.5錠を「””」、3錠を「""」として変換して
一応消されはするのですが、ピポットテーブルにのせると同じものと認識しないが、
これにはなにか残っているようなのですが・・。これを消して同じものとして
認識するためにはどうすればいいか。クリーン関数などというのもあるようだが、使い方が
わからない。

Aベストアンサー

>1.5錠を「””」、3錠を「""」として変換して

これ、どうやったんですか？数式？
置換機能？
◯◯錠の後ろにスペースが残っているのでは？

=CLEAN(TRIM(A1))

とかで、一度にやってしまったら如何でしょうか？

他の回答も見る

Qエクセル セル内の除去について

エクセルのセル一つについて　「〇○○　　×××　　」と文字○があった場合、〇○○の右の空白のスペースからすべて右側を×××を含めて除去する方法はありませんか。〇○○、×××の文字、文字数はセルごとに違うものとします。

Aベストアンサー

例えば、
A1に、

> 「〇○○　　×××　　」

が入力されているとして、

B1に、
=FIND("　",A1)
で最初に空白文字が現れる文字の場所を取得。

C1に、
=LEFT(A1,B1-1)
で最初に空白が現れるより左の文字列を取得。

とか。

他の回答も見る

QエクセルでLOOKUP関数など使いこなせない

体力測定記録で年齢、得点を入れたら評定基準でABCDを返すようにしたい。
例えば　　年齢７２　得点３５　　　　　評定段階　C
Cを求める数式を知りたい。どなたかよろしくお願いします。

Aベストアンサー

こんにちは！

一例です。
↓の画像のE1～H6セルのように表を作成しておきます。

C2セルに
=IF(COUNTBLANK(A2:B2),"",INDEX(E$2:E$6,MATCH(B2,OFFSET(E$2:E$6,,MATCH(A2,F$1:H$1,1)),1)))

という数式を入れフィルハンドルで下へコピーしています。

※　表の並びを少しだけ説明すると・・・
F列　→　0歳以上～70歳未満
G列　→　70歳以上～75歳未満
H列　→　75歳以上
となり、行方向に関しても同様な区分けになり、
仮にF列の場合は
2行目　→　0以上～25未満
3行目　→　25以上～33未満
4行目　→　33以上～41未満
5行目　→　41以上～49未満
6行目　→　49以上
といった具合です。

他の列も同様の感じになります。m(_ _)m

他の回答も見る
ページトップページトップ

Q質問する（無料）

このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング

おすすめ情報