- ベストアンサー
エクセルVBAで任意の文字列を抽出するには・・・
エクセル2003で作成した住所録があります。 県名（３文字）のみを抽出して、新たに設けたD列に表示させたいと考えています。 Sub 県名の列作成() Dim myStr As String myStr = ActiveCell.Value Range("D2").Value = Left(myStr,3) End Sub ここまで、できたのですが・・・・ B列の２行目から順に処理をして、一覧表の最後まで行って、 空白セルの行が見つかったら終了させる方法が分かりません。 どうかよろしくお願いします。
- oshiete100goo
- お礼率75% (21/28)
- Visual Basic
- 回答数2
- ありがとう数3
- みんなの回答 （2）
- 専門家の回答
関連するQ&A
- Excel VBA でテキストボックスの値をセルA列から検索
いつもお世話になります。 Private Sub CommandButton3_Click() Dim 行 As String Dim 列 As String Dim 最終行 As String Dim 検索行 As String Dim メッセージ As Integer Dim 一致 As Range Dim myNO As Variant Dim i As Long Sheets(3).Select 最終行 = Range("A2").End(xlDown).Offset(1).Select 行 = ActiveCell.Row 列 = ActiveCell.Column myNO = TextBox2.Value 検索行 = Range("A2").End(xlDown).Select ※・・・Set 一致 = Range("A2:検索検").Findwhat:=TextBox2,lookat:=xlWhole) If 一致 Is Nothing Then MsgBox "データがありません。新規コード入力します。" Cells(行, 列 + 0) = UserForm1.TextBox2.Value Cells(行, 列 + 1) = UserForm1.ComboBox7.Value Else i = Cells(行 - 1, "A") Cells(i, 列 + 0) = UserForm1.TextBox2.Value Cells(i, 列 + 1) = UserForm1.ComboBox7.Value End If End Sub 「エラー1004'Range'メソッドは失敗しました'Global'オブジェクト」とでます。※印が黄色になっています。 ユーザーフォーム1のテキストボックスの値をシート3のA列から検索して、一致すれば、A列の一致セルに上書き入力して、一致が無い場合はA列の空白セルに追加入力したいのです。よろしくお願い致します。
- ベストアンサー
- その他（プログラミング・開発）
- excel vbaでの質問になります
このようなマクロを作成したのですが、セルに数式が入れてあると、どうしてもその下の空白の行に値を入力されてしまいます。 数式が入っているセルにもそのままセルに値を入れたいのですが・・ 宜しくお願いします。 Dim wb1 As Worksheet, r1 As Range Dim N As Integer, i As Integer Dim mycount As Long Set wb1 = ThisWorkbook.Worksheets("請求書") mycount = Range("B111").CurrentRegion.Rows.Count Cells(111 + mycount, 2).Select ActiveCell.Offset(0, 0).Value = wb1.Range("C60").Value ActiveCell.Offset(0, 1).Value = wb1.Range("C61").Value ActiveCell.Offset(0, 12).Value = wb1.Range("C66").Value ActiveCell.Offset(0, 13).Value = wb1.Range("C74").Value ActiveCell.Offset(0, 14).Value = wb1.Range("C75").Value ActiveCell.Offset(0, 15).Value = wb1.Range("C84").Value ActiveCell.Offset(0, 16).Value = wb1.Range("C85").Value ActiveCell.Offset(0, 20).Value = wb1.Range("C69").Value ActiveCell.Offset(0, 22).Value = wb1.Range("C68").Value ActiveCell.Offset(0, 23).Value = wb1.Range("C76").Value ActiveCell.Offset(0, 24).Value = wb1.Range("C77").Value Exit Sub
- 締切済み
- Visual Basic
- エクセルVBA抽出がうまく出来ません
エクセル2013VBA初心者です。 入力シートからＤＢシートへ、ＤＢシートから印刷シートへのデータ転記と印刷、入力内容のクリアまでは出来るようになりました。 ＤＢシートの検索を行い、記録内容を入力シートに転記する抽出を行いたいのですが、下記構文を書いたところで問題が発生しました。 If Sh2.Range("A & i").Value = j And Sh2.Range("B & i").Value = k Then でとまります。メッセージは ‘Range’メソッドは失敗しました：‘Workshieet’オブジェクトというものです。 やろうとしていることは、入力シートに設けた“E12”と”G12”の二つの検索項目をキーにDBシートの行を特定し、この行の内容を入力シートに反映しようということです。 入力シートの検索項目“E12”、 ”G12”はそれぞれDBシートのA列、B列に格納されている項目で、年度と連番です。サンプルとして入力シート"C5"に抽出しようとしているDBシートD列は申請者名です。 恐れ入りますがよろしくご教示頂きたく、お願い申し上げます。 Sub DBシートから力情報を抽出する () Dim Sh1 As Worksheet Dim Sh2 As Worksheet Dim i As Long Dim j As Long Dim k As Long Set Sh1 = Worksheets("入力") Set Sh2 = Worksheets("DB") j = Sh1.Range("E12").Value k = Sh1.Range("G12").Value With Sh2 For i = 2 To .Range("A" & Rows.Count).End(xlUp).Row If Sh2.Range("A & i").Value = j And Sh2.Range("B & i").Value = k Then Sh1.Range("C5").Value = Sh2.Range("D & i").Value End If Next End With End Sub
- ベストアンサー
- Excel（エクセル）
- 文字列の最後が空白なら削除する
Sub test() Dim mystr As String mystr = "abc " If Right(mystr, 1) = " " Then Debug.Print Left(mystr, Len(mystr) - 1) End If End Sub これで、最後の１文字が空白なら削除できるのですが、 "abc "のように、最後に空白が２つある場合が対応できないのですが そういう場合でも対応できるコードはありますか？
- ベストアンサー
- オフィス系ソフト
- 配列 変数の宣言 ＶＢＡ
こんばんは。 Sub test() Dim myStr(200) As String For 行 = 0 To Cells(Rows.Count, 1).End(xlUp).Row myStr(行) = Cells(行 + 1, 1) Next MsgBox Join(myStr, "_") End Sub のようなコート゛を作成し、 アクティブシートのＡ列の最終行までを取得し、一つにまとめたいのですが 「Dim myStr(200) As String」の部分で 最終行を取得することは不可能でしょうか？ 今回は２００行なので大丈夫なのですが 場合によっては1行～65536行までさまざまです。 なので Dim myStr(Cells(Rows.Count, 1).End(xlUp).Row) As String としたらエラーになりました。 最初から Dim myStr(65536) As String とするべきでしょうか？ しかしそうすると myStrの最後がずっと「________」となってしまいます。 どうするのが適切なのかわかりません。 ご教授よろしくお願いします。
- ベストアンサー
- オフィス系ソフト
- VBA エクセル 文字列
A列に、【鈴木 太郎】、【佐藤 一郎】・・・・と続いていて、B列には鈴木、佐藤・・・と表示させたい場合は以下のソースに、 =LEFT(A1,FIND(" ",SUBSTITUTE(A1," "," "))-1) と同じソースを書けばいいのはわかるのですが、勉強不足でわかりません。教えていただけませんでしょうか。下記のソースも教えていただきました。すごく助かります。 Sub PickupWords() Dim Matches As Object Dim Match As Object Dim buf As String Dim c As Variant With CreateObject("VBScript.RegExp") .Pattern = "【(.+)】" .Global = False Application.ScreenUpdating = False For Each c In Range("A1", Cells(Rows.Count, 1).End(xlUp)) If .Test(c.Value) Then buf = c.Value Set Matches = .Execute(buf) c.Offset(, 1).Value = Matches.Item(0).SubMatches(0) '括弧の中を取り出す End If Next c Application.ScreenUpdating = True End With End Sub
- ベストアンサー
- その他MS Office製品
- エクセルで列抽出できる関数かマクロを探しています。
エクセルで列抽出できる関数かマクロを探しています。 マクロ初心者です。 表の形は、 A1 B1 C1 D1 E1 容量 0.1 5.5 11 22 形式 NF30 NF63 NF125 NF250 カバー TCS … と、電気部品のモータ容量と定格電流で抽出したいのです。 行で抽出するととても見づらく、列で一気に見れるように （制御器選定スケールの様に）したいのです。 スケールだけで形式は選定できるのですが、カバーも選定するために 毎回カタログで確認するのは仕事の効率が良くなく 表を作成しようと思いたったのですが・・・ いろいろ探してみたのですが、今のところ見つからず 今試しているのが、表を一度コピーして列行を入れ替えて 別シートにコピーしたものを作成してからオートフィルタをかけて 抽出したデータを別シートにもう一度列行を入れ替えて貼り付けする 方法しか考え出せていません。 質問なんですが、 上記のように列抽出できる関数やマクロがあるのか？ それとも一度行抽出に変えて最後に列に戻すやり方の方が良いのか？ 又、そのやり方を初心者なりに作成してみたのですが 1回目は出来ても、容量が変わるとエラーが出てきて出来ません。 Sub Macro1() Range("A31").Select ActiveCell.FormulaR1C1 = "=Sheet1!R5C2" Range("J31").Select ActiveCell.FormulaR1C1 = "=Sheet1!R6C2" Range("J32").Select ActiveWindow.SmallScroll Down:=-9 Range("A1:X24").Select Range("A1:X24").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _ Range("A30:X31"), Unique:=False ActiveWindow.SmallScroll Down:=-12 Selection.Copy Sheets("Sheet1").Select Range("F1").Select Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=True Sheets("Sheet3").Select Application.CutCopyMode = False ActiveSheet.ShowAllData End Sub たぶん、行列の入れ替えが上手くいかないのかなとは素人ながらに考えて 色んなサイトで調べてみていじってみるのですが、なかなか上手くいきません。 皆様、宜しくお願いいたします。
- ベストアンサー
- Windows系OS
- Excel VBAの繰り返し構文について
A列に日付、B列に曜日、C列に休、D列に1直、E列に2直、という形の年間シフトを作成しています。 初期値としてA2セルに数字を入力→C列が空白の時だけD列に記入するマクロを作成したと思っています。 現在仮として、 Sub C列のセルが空白の行のD列に数値を入力() 下端行 = Range("A" & Rows.Count).End(xlUp).Row '下端検出 For 行 = 3 To 下端行 '1行目から下端行まで1行ずつ繰り返す If Range("C" & 行).Value = "" Then 'その行のC列のセルの値が空白の時 Range("A2").Copy 'A2をコピーする Range("D" & 行).PasteSpecial Paste:=xlPasteFormulas 'その行のA列のセルを起点に 'して数式を貼り付ける End If Next End Sub というマクロを置いていますが、「Range("A2").Copy」の部分を 「A2を初期値として、最初にC列が空白でなくなる時まで初期値を繰り返し、次にC列が空白になった場合は初期値+1の数をD列に入力する。 ただし初期値+1の最大数は6までとする（要するに1～6の繰り返しです）」 という感じに変更したいのですが、どうすればいいのかさっぱりです…。 VBAレベルはこの質問をする程度なのでかなり初級です。
- ベストアンサー
- その他MS Office製品
- EXCEL VBA
EXCEL VBAで空白行が現れたら「小計」の文字を入力したいと思い以下のように記述しましたが、うまくいきません。どこがおかしいのか教えてください。 宜しくお願いします。 Sub write小計() Dim i As Integer Dim rowcnt As Integer rowcnt = Cells(1, 1).CurrentRegion.Rows.Count Range("B1").Select For i = 1 To rowcnt If Cells(i, 2).Value = "" Then Value = "小 計" ActiveCell.Offset(1).Select Next i End Sub
- ベストアンサー
- オフィス系ソフト
- エクセルVBAで、複数のブックからデータベースを作りたい
こんにちは。ＶＢＡをはじめたばかりの者です。 変数の使い方で教えていただきたいことがあります。 Dim myFLName As String myFLName = ThisWorkbook.Path & "\001.xls" Workbooks.Open Filename:=myFLName, ReadOnly:=True Workbooks("dbase.xls").Activate Range("A2").Select ActiveCell.Value = 1 ActiveCell.Offset(, 1).Select ActiveCell.Value = Workbooks("001.xls").Worksheets(1).Range("R3") ActiveCell.Offset(, 1).Select ActiveCell.Value = Workbooks("001.xls").Worksheets(1).Range("C2") ActiveCell.Offset(, 1).Select ActiveCell.Value = Workbooks("001.xls").Worksheets(1).Range("R2") ActiveCell.Offset(1, -3).Select 001.xls～（連番でない）200.xlsくらいまでのファイルがあり、 同じフォルダにdbase.xlsを作って1ブックから１レコードになるようにしたいと 思います。 こんな感じで１行目はできたのですが、２行目の１列目に「2」を入れ、 2列目からは001.xlsの次のブックを開いてセルの中身をコピーしたいのです。 変数の使い方がよくわからないのですが、教えていただけますでしょうか。 よろしくお願いいたします。
- ベストアンサー
- オフィス系ソフト
- 質問文章からセンセーショナルなタイトルを30文字前後で生成
- input.htmlで検索条件の入力フォームを作成し、入力が完了したら「検索開始」ボタンでsearch.phpに遷移する方法を教えてください。
- 重たい検索処理の間に表示されるメッセージを実現する方法が分からないので、Web設計に詳しい方からのアドバイスをお願いします。
お礼
完璧です。ありがとうございました。