- ベストアンサー
[VBA] InStrRevとLikeの組合せ
30246kikuの回答
- 30246kiku
- ベストアンサー率73% (370/504)
まだ締め切られていなかったので、解釈パターンを適当に多くしてみました。 解決済みだが他を試してみる・・・ 面倒であればスルーしてください。 「-」区切りの「物件名」先頭を分割する部分は、半角で、0 ～ 9、A ～ Z の範囲とします。 千代田区千代田1-1-1千代田マンション１号棟 千代田区千代田1-1-1千代田マンション－１号棟 千代田区千代田1-1-1-301A千代田マンション１号棟 千代田区千代田1-1-1-301ＣＨＩＹＯ田マンション１号棟 千代田区千代田1-1-1-301a千代田マンション１号棟 千代田区千代田1-1--301千代田マンション１号棟 千代田区千代田1--1-301千代田マンション１号棟 千代田区千代田1-2-3-4F千代田マンション１号棟 千代田区千代田1-2-4F千代田マンション１号棟 千代田区千代田1-4F千代田マンション１号棟 千代田区千代田1-2-3-A-405千代田マンション 千代田区千代田1-2-3-4-506千代田マンション 千代田区千代田1-2-A-301千代田マンション 千代田区千代田1-B棟-506千代田マンション 千代田区千代田1-2-B棟-千代田マンション 千代田区千代田1-2千代田マンション１号棟 千代田区千代田1-2-千代田マンション１号棟 千代田区千代田1-2-3 千代田区千代田1-1-A-301 千代田区千代田2 は、 千代田区千代田1-1-1 千代田マンション１号棟 千代田区千代田1-1-1 千代田マンション－１号棟 千代田区千代田1-1-1 千代田マンション１号棟 301A 千代田区千代田1-1-1 ＣＨＩＹＯ田マンション１号棟 301 千代田区千代田1-1-1 a千代田マンション１号棟 301 千代田区千代田1-1 千代田マンション１号棟 301 千代田区千代田1 千代田マンション１号棟 1-301 千代田区千代田1-2-3 千代田マンション１号棟 4F 千代田区千代田1-2 千代田マンション１号棟 4F 千代田区千代田1 千代田マンション１号棟 4F 千代田区千代田1-2-3 千代田マンション A-405 千代田区千代田1-2-3 千代田マンション 4-506 千代田区千代田1-2 千代田マンション A-301 千代田区千代田1 千代田マンション B棟-506 千代田区千代田1-2 千代田マンション B棟 千代田区千代田1-2 千代田マンション１号棟 千代田区千代田1-2 千代田マンション１号棟 となり、以下３つは何もしません。 千代田区千代田1-2-3 千代田区千代田1-1-A-301 千代田区千代田2 ※ 間違って複数回実行しても、分割対象でなかったものへは何もしません （分割対象は、最後の「-」以降に [!0-9A-Z] が存在したら） ※ 不都合あれば変更してください 途中にスペースが入っている場合がある・・・ とか ※ ソコソコ動くと思いますが、処理性能はわかりません Option Explicit Public Sub test1() Dim vAry(1) As Variant, v As Variant Dim sS As String, sP As String Dim iU As Long, iM As Long Dim i As Long, j As Long For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row v = Split(Cells(i, 1).Value, "-") iU = UBound(v) If (iU > 0) Then vAry(1) = Empty sS = v(iU) For j = 1 To Len(sS) If (Mid(sS, j, 1) Like "[!0-9A-Z]") Then vAry(1) = Mid(sS, j) v(iU) = Mid(sS, 1, j - 1) Exit For End If Next If (Not IsEmpty(vAry(1))) Then iM = 0 sP = " " ' 全角のスペース１個 For j = 1 To iU If (iM = 0) Then If ((j >= 3) Or (Len(v(j)) = 0) _ Or (v(j) Like "*[!0-9]*")) Then iM = j End If If ((iM > 0) And (Len(v(j)) > 0)) Then vAry(1) = vAry(1) & sP & v(j) sP = "-" End If Next If (iM > 0) Then ReDim Preserve v(iM - 1) vAry(0) = Join(v, "-") Cells(i, 1).Resize(, 2) = vAry End If End If Next End Sub
関連するQ&A
- VBAで実行時エラー'13': がでます
初歩の初歩ですいません。 VBAで Dim A As Integer Dim B As Integer Dim C As Integer Dim gokei As Integer For i = 8 To 70 A = Cells(i, 4).Value B = Cells(i, 5).Value C = Cells(i, 6).Value goukei = A + B + C Cells(i, 7) = goukei Next i としていますが A = Cells(i, 4).Value のところで今使っているシートだと止まってしまいます。 新規でワークシートを使って仮に数字を代入すると普通に動きます。 今使っているシートもセル内には =100 と入力して 100 と表示され セルの書式設定も数値になってるんですがどうしてでしょうか？
- ベストアンサー
- その他MS Office製品
- VBAの得意な方、教えてください(初心者です)
エクセルのシートが セルA1に1 セルA2に2 セルA3に3 セルA4に4 セルA5に5 という数字が入っています。 で、セルD4には"=D2*5"という数式が入っています。 セルD2にA1の数値を代入して、出てきた数値をB1に入力、 次にD2にA2の数値を代入して、出てきた数値をB2に入力…以下続く というのをVBAで書いてみたら、下のような感じになりました。 Sub test() Dim d1 As Integer Dim d2 As Integer Dim d3 As Integer Dim d4 As Integer Dim d5 As Integer Dim p1 As Integer Dim p2 As Integer Dim p3 As Integer Dim p4 As Integer Dim p5 As Integer d1 = Cells(1, 1).Value Cells(2, 4).Value = d1 p1 = Cells(4, 4).Value Cells(1, 2).Value = p1 d2 = Cells(2, 1).Value Cells(2, 4).Value = d2 p2 = Cells(4, 4).Value Cells(2, 2).Value = p2 d3 = Cells(3, 1).Value Cells(2, 4).Value = d3 p3 = Cells(4, 4).Value Cells(3, 2).Value = p3 d4 = Cells(4, 1).Value Cells(2, 4).Value = d4 p4 = Cells(4, 4).Value Cells(4, 2).Value = p4 d5 = Cells(5, 1).Value Cells(2, 4).Value = d5 p5 = Cells(4, 4).Value Cells(5, 2).Value = p5 End Sub ここで質問です。 例では5個しかないのですが、実際は100行くらいのデータなんで 大変です。もっと簡単にする方法はありますか？ 実際のセルD4の数式は、他からも参照したりしているので、 ここはいじらずに教えてください。 Excel2000、Visual Basic 6.0 ってのを使っています。 よろしくお願いいたします。
- ベストアンサー
- オフィス系ソフト
- VBAで関数を使うには？
こんな感じだったとします。 Ａ１ Ｂ１ 2002/9/2 2002/9/3 2002/9/4 2002/9/5 ： このＢ１にそれぞれの曜日を表示させるVBAを以下のようにしました。 Sub youbi() Dim i As Integer For i = 3 To 10 Cells(i, 3).Value = Weekday(Cells(i, 2), "aaa") Next End Sub もちろんエラーでした。 （メッセージは「型が一致しません」です。） そこで以下のように変更しました。 Sub youbi() Dim i As Integer For i = 3 To 10 Cells(i, 3).Value = "=text(Weekday(b3), ""aaa"")" Next End Sub するときちんと曜日が表示されたのですが、もちろん全部B3のセルの日付の曜日です。 ここを変数にするにはどうしたらいいのでしょうか？ とっても簡単なことのように思えますが、意外とハマってしまって抜け出せません。 よろしくお願いします。
- ベストアンサー
- オフィス系ソフト
- エクセルVBAで、特定の数字になる組み合わせを知りたいのですが・・・
A.5380、B.4730、C.3310、D.2840、E.2360、F.1890、G.1420、H.940 以上８種類の数字を組み合わせて、合計13010ちょうどになる組み合わせをすべて知りたいです。８種類の数字は、同じものを何度組み合わせても構いません。 例えば、A+A+B=○のようにです。 色々自分なりに調べたところ、ソルバーで試してみましたが、組み合わせの数字が複雑な為か、解答はでませんでした。 また、VBAを使用して以下のような例が掲載されていたので試してみましたが、オーバーフローしてしまって答えがでません。 VBAがまったくの初心者のため、どのようにしたら問題が解消されるのかわかりません。 どなたか教えていただけませんでしょうか。お願いします。 ' knapsack総当たり ' 目標値と一致する物をすべて求める ' 'by S. Tada Const N = 8 ' データの数 Dim wa(N) As Long Sub knap_main() Dim w As Long, wmax As Long Dim i As Integer, j As Long, k As Integer Dim y1 As Integer, y2 As Integer Dim b As Long y1 = 1 ' A1:Anにデータを入れておく y2 = y1 + 1 ' B列以降が結果 For i = 1 To N wa(i) = Cells(i, y1).Value Next wmax = Cells(45, y1).Value ' A45に目標値を入れておく For j = 1 To 2 ^ N - 1 w = 0 b = 1 For k = 1 To N If j And b Then w = w + wa(k) b = b + b Next If w = wmax Then b = 1 For k = 1 To N If j And b Then Cells(k, y2).Value = wa(k) b = b + b Next y2 = y2 + 1 End If Next End Sub
- ベストアンサー
- オフィス系ソフト
- VBAで行列を作る方法
次のようなプログラミングで１，０，－１の要素で作られる3×3行列を全通り調べています。 この場合３の９乗通り調べることができます。 これを4×4や５×５行列など数を大きくして調べたいのですが、このプログラムを配列を使うなどして 簡単にできる方法を教えてください。 よろしくおねがいします。 Sub test() Dim a As Integer '行 Dim b As Integer '列 Dim c As Integer, i As Integer, j As Integer, d As Integer, e As Integer Dim 内積 As Integer, step As Integer Dim f As Integer, g As Integer, h As Integer, l As Integer, m As Integer, n As Integer, k As Integer, x As Integer Dim sum As Integer, total As Integer Dim aa As Integer, aaa As Integer, aaaa As Integer, bb As Integer, bbb As Integer, bbbb As Integer a = 3 '行 b = 3 '列 c = 0 内積 = 0 con = 0 sum = 0 tatal = 0 aa = 0 aaa = 0 aaaa = 0 bb = 0 bbb = 0 bbbb = 0 x = 0 For n = 0 To 2 For m = 0 To 2 For l = 0 To 2 For k = 0 To 2 For h = 0 To 2 For g = 0 To 2 For f = 0 To 2 For e = 0 To 2 For d = 0 To 2 '要素がすべて１ For i = 1 To a For j = 1 To b Cells(i, j) = 1 Next j Next i If bbbb = 1 Then Cells(a - 2, b - 2) = 0 ElseIf bbbb = 2 Then Cells(a - 2, b - 2) = -1 End If If bbb = 1 Then Cells(a - 1, b - 2) = 0 ElseIf bbb = 2 Then Cells(a - 1, b - 2) = -1 End If If bb = 1 Then Cells(a, b - 2) = 0 ElseIf bb = 2 Then Cells(a, b - 2) = -1 End If If aaaa = 1 Then Cells(a - 2, b - 1) = 0 ElseIf aaaa = 2 Then Cells(a - 2, b - 1) = -1 End If If aaa = 1 Then Cells(a - 1, b - 1) = 0 ElseIf aaa = 2 Then Cells(a - 1, b - 1) = -1 End If If aa = 1 Then Cells(a, b - 1) = 0 ElseIf aa = 2 Then Cells(a, b - 1) = -1 End If If total = 1 Then Cells(a - 2, b) = 0 ElseIf total = 2 Then Cells(a - 2, b) = -1 End If If sum = 1 Then Cells(a - 1, b) = 0 ElseIf sum = 2 Then Cells(a - 1, b) = -1 End If If con = 1 Then Cells(a, b) = 0 ElseIf con = 2 Then Cells(a, b) = -1 End If con = con + 1 Next d con = 0 sum = sum + 1 Next e sum = 0 total = total + 1 Next f total = 0 aa = aa + 1 Next g aa= 0 aaa = aaa + 1 Next h aaa = 0 aaaa = aaaa + 1 Next k aaaa = 0 bb = bb + 1 Next l bb = 0 bbb = bbb + 1 Next m bbb = 0 bbbb = bbbb + 1 Next n End Sub
- ベストアンサー
- オフィス系ソフト
- VBA勉強中、教えてください。
下のような表のA、B、Cの期間ごとの合計を出したいのですがうまくいきません。 マスター(sheet1) 合計(sheet2) A B C D A B C 1 商品A 商品B 商品C 1 7 合計 2 12/25 18 10 20 2 2/31 3 12/26 18 11 15 3 商品A 4 12/27 20 12 10 4 商品B 5 12/28 24 20 16 5 商品C 6 12/29 30 18 15 7 12/30 18 30 25 8 12/31 23 21 10 ユーザーフォームに日付と何日(数字入力)のフォームが作ってあります Dim i As Integer, x As Integer,dy1 As Variant,gk1 As Variant, tag1 As Variant, cnt As Integer cnt = Worksheets("合計"),Range("A1") dy1 = Application.Match(Worksheets("合計").Range("A2"), Worksheets("マスター").Range("A:A"), 0) For x = 0 To 3 tag1 = Application.Match(Worksheets("合計").Cells(3 + x, 2), Worksheets("マスター").Range("1:1"), 0) For i = 0 To cnt gk1 = gk1 + Worksheets("マスター").Cells(dy1 - i, tag1).Value Next i Worksheets("合計").Cells(2 + x, 3).Value = gk1 Next x このようなコードにしたのですが合計がA→B→Cとすべて足されてしまいます。A,B,Cとそれぞれの合計を出すにはどのようにしたらよいのでしょうか？ 思考錯誤したのですが初心者なのでよくわかりません。 どなたかわかる方が居たら教えてください。よろしくお願いします。
- ベストアンサー
- Visual Basic
- 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で計算誤差がでます。 ？
以前作成したコードを見直しています。 例えば、 A2 : 1. plat_form (5:50) A3: 2. cloud Two (4:12) の場合、マクロを実施すると B2: 0:05:50 B3: 0:04:12 と表示されました。 C列にはB列を秒([s].000）に変更後に文字列に変換した値が出るはずが 以下のように変な値になっています。 （------＞ の右の値は、C列をクリックしたときに数式バー表示される値です。 C2をクリックすると数式バーに「0:05:46」と表示される。 実際は、「0:05:50」のはずで350.000が正解のはずで誤差が出る？） C2: 345.600 -----> 0:05:46 C3: 259.200 -----> 0:04:19 これは、EXCELの計算誤差なのでしょうか？ その場合、 正常に表示されるコードを教えて下さい。 以下のコードを参照ください。------------------ Option Explicit Sub ①時間相当の抜き出し() Dim i As Double Dim LSN As Double '処理列の個数 LSN = Cells(Rows.Count, "A").End(xlUp).Row 'B列の文字列で最後から検索して検索文字より右側を抜き出す For i = 2 To LSN Cells(i, "B") = "0:" & カッコ内の文字列を取得する(Cells(i, "A"), "(", ")") Cells(i, "C").Value = Format(Cells(i, "B"), "[s].000") Next End Sub Function カッコ内の文字列を取得する( _ 元の文字列 As String, _ Optional 開くカッコ As String = "(", _ Optional 閉じカッコ As String = ")") _ As String Dim pos_a As Long ' 開くカッコの位置 Dim pos_z As Long ' 閉じカッコの位置 pos_a = InStr(1, 元の文字列, 開くカッコ) pos_z = InStr(pos_a + 1, 元の文字列, 閉じカッコ) カッコ内の文字列を取得する = _ Mid(元の文字列, pos_a + 1, pos_z - pos_a - 1) End Function
- ベストアンサー
- Excel（エクセル）
- VBA Next For でのコピペについて
EXCEL VBA初心者です。 AシートEW44からGD44までをコピーしてBというシートの最終行へコピーしたいです。 今下記のように組んでいるのですが、うまく作動しません。 Private Sub CommandButton1_Click() Dim i As Integer For i = 153 To 186 row1 = Worksheets("B").Cells(Rows.Count, 27).End(xlUp).Row Worksheets("A").Cells(i, 44).Value = Worksheets("B").Cells(row1 + 1, 27).Value Next i End Sub アドバイスいただけませんでしょうか。
- ベストアンサー
- Excel（エクセル）
- エクセル2019 VBAについて
エクセル2019でVBAを使いコピーペーストの勉強中です、次の箇所(Dim i As integr)で、ユーザー定義型は定義されていませんと指摘されて止まってしまします、Sheet("データ")には3行のデータは入っています、VBA初心者のため、この後が、なかなか前に進めません、どうかよろしくおねがいします。 ********************************** Sub 練習() Dim s1 As Worksheet: Set s1 = Worksheets("請求書") Dim s2 As Worksheet: Set s2 = Worksheets("データ") Dim r1 As Integer: r1 = 18 Dim r2 As Integer: r2 = 2 { Dim i As integr } For i = 0 To 2 s1.Range(s1.Cells(r1 + i, 1), s1.Cells(r1 + i, 3)).Value = s2.Range(s2.Cells(r2 + i, 2), s2.Cells(r2 + i, 4)).Value s1.Cells(r1 + i, 4).Value = s1.sells(r1 + i, 2).Value * s1.Cells(r1 + i, 3).Value Next End Sub ***************************************
- ベストアンサー
- Excel（エクセル）