- ベストアンサー
【エクセルｖｂａ】(1)(2)(3)を区切りとして分けたい 配列
こんばんは。 もしエクセルで可能なら教えていただきたいです。（2003です） A1セルに (1)りんご(2)みかん(3)バナナ と入力されています。 これを A2にりんご、B2にみかん、C2にバナナ とSplitと使って区切りたいのですが不可能でしょうか？ 以下がここのサイトを参考にして作ったサンプルマクロです。 Sub サンプル() Dim myStr As String Dim ar As Variant myStr = Cells(1, 1) ar = Split(myStr, "") '←この部分をどうすればいいのかわからない Cells(2, 1).Resize(1, UBound(ar) + 1).Value = ar End Sub やはり、区切る文字が複数ある場合は不可能でしょうか？ ご教授よろしくお願いします。
- 5tgbhy
- お礼率96% (363/378)
- オフィス系ソフト
- 回答数5
- ありがとう数6
- みんなの回答 （5）
- 専門家の回答
質問者が選んだベストアンサー
一例ですが正規表現を用いてます。 Sub try() Dim myReg As Object Dim myStr As String Dim ar As Variant Set myReg = CreateObject("VBScript.Regexp") myReg.Pattern = "\(\d+\)" myReg.Global = True myStr = Cells(1, 1).Value If myReg.Test(myStr) = False Then Exit Sub ar = Split(myReg.Replace(myStr, ","), ",") Cells(2, 1).Resize(1, UBound(ar) + 1).Value = ar Set myReg = Nothing End Sub ご参考になれば。
その他の回答 (4)
- imogasi
- ベストアンサー率27% (4737/17068)
VBAにない正規表現（FSOにあるが）を避けて、何とか他の方法は無いかと考えた。 エクセルの置換で （＊）（＊はワイルドカード的意味での＊）－－＞/（何でもよい。りんごなど品名には出て来そうに無い文字） に置換 後は普通のSplit関数の応用 最初の/が空白のデータを返すので For i = 1 To UBound(y)で、0からで無く１より以後を取り、０の分を捨てた。 前半は検索操作のマクロの記録を使った。 ーーーー Sub test01() Cells.Replace What:="(*)", Replacement:="/", LookAt:=xlPart, SearchOrder _ :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False '--- i = 1 x = Cells(i, "A") y = Split(x, "/") For i = 1 To UBound(y) MsgBox y(i) Next End Sub ーー Cells.Replace になってますが、対象セル範囲や行列全体などで置換範囲を限定できます。データに実情に合わせて修正してください。
お礼
おお！なるほど！ これは理解できました！ こんなこともできるのですね！ ありがとうございます。
- Wendy02
- ベストアンサー率57% (3570/6232)
こんにちは。 正規表現パターンは、複雑な内容でも修正が簡単なので確かに便利ですが、今回のような単純な内容の場合は、以下のような方法も覚えておくと、役に立つはずです。VBAでは、私は、小規模のものに対しては、正規表現を使いますが、大規模ではあまり使いません。勉強をするなら、別途、パターンの専門書で勉強しないと、分からない部分があります。 >(1)りんご(2)みかん(3)バナナ （括弧に全角を混ぜても可能です。) Sub Test1() Dim txt As String Dim i As Long, j As Long Dim ar() As String Dim k As Long txt = Cells(1, 1).Value i = 1 Do i = InStr(i, txt, ")", 1) j = InStr(i + 1, txt, "(", 1) ReDim Preserve ar(k) If j > 0 Then ar(k) = Trim(Mid(txt, i + 1, j - i - 1)) k = k + 1 Else ar(k) = Trim(Mid(txt, i + 1)) End If i = j + 1 Loop Until (i = 0 Or j = 0) Cells(2, 1).Resize(, UBound(ar()) + 1).Value = ar() End Sub http://msdn.microsoft.com/ja-jp/library/ae5bf541.aspx 正規表現の構文
お礼
おお！これもできました！ 皆さんすごいですね！ とても参考になりました。 ありがとうございます。
- n-jun
- ベストアンサー率33% (959/2873)
n-junです。 ＞VBScript関連でしょうか？ そうですね。 私の中では正規表現は利用頻度が高いです。 ＞"\(\d+\)" 半角の( と 半角の)に囲まれた半角数値１回以上 を順次","に置換し、その後","で区切ってます ⇒ ar = Split(myReg.Replace(myStr, ","), ",")
お礼
なるほど～ 正規表現についてよく調べてみます。 お忙しい中ありがとうございます！！！ 本当に助かりました！
関連するQ&A
- 二次元配列のVBA
二次元配列のVBAの書き方がよくわからないのですが、 私が作ったサンプルプログラムのSub 二次元()において 二次元配列で表すにはどうすればいいのでしょうか？ Sub 二次元()では 配列を格納する変数はtmpしか使っていませんが もう一つ配列を格納する用の変数を作ればいいのでしょうか？ 数字とアルファベットは別々に取り出したいです。 ----------------------------------------------------- Sub 一次元() Dim myStr As String Dim tmp As Variant Dim i As Long For i = 1 To 5 myStr = myStr & "," & i Next myStr = Mid(myStr, 2) tmp = Split(myStr, ",") For i = LBound(tmp) To UBound(tmp) Debug.Print tmp(i) Next i End Sub Sub 二次元() Dim myStr As String Dim tmp As Variant Dim i As Long For i = 1 To 5 myStr = myStr & "," & i & "と" & Chr(64 + i) Next myStr = Mid(myStr, 2) tmp = Split(myStr, ",") For i = LBound(tmp) To UBound(tmp) Debug.Print tmp(i) Next i End Sub
- ベストアンサー
- Excel（エクセル）
- vbaで配列に値を格納する場合
vbaで配列に値を格納する場合 変数の宣言はどちらを使った方が良いのでしょうか？ Sub Sample1() Dim i As Long Dim myStr As String Dim tmp() As String myStr = "a,i,u,e,o" tmp = Split(myStr, ",") End Sub か Sub Sample1() Dim i As Long Dim myStr As String Dim tmp As Variant myStr = "a,i,u,e,o" tmp = Split(myStr, ",") End Sub でも問題なく動くのですが、 Variant型での宣言はあまりしない方が良いですか？ あと Dim tmp() As String ならエラーにならないのですが Dim tmp As String だとエラーになってしまう理由がよくわからないので教えて頂けますか？
- ベストアンサー
- オフィス系ソフト
- エクセルVBAで配列？
以下は、文字列"t", "e", "s", "t"を配列に取り込み、セルに表示する例ですが、 ar = Array("t", "e", "s", "t") なら作動しますが、セル範囲から取り込もうと、 ar = Range("A1:D1").Value とするとエラーになります。 どうしてでしょうか？ Sub test() Dim ar As Variant Dim n As Integer ar = Array("t", "e", "s", "t") 'ar = Range("A1:D1").Value For n = LBound(ar) To UBound(ar) Cells(n + 1, 5) = ar(n) Next n End Sub
- ベストアンサー
- オフィス系ソフト
- エクセルＶＢＡ 文字化けします。
初心者ですみません、ネットで調べたコードなのですが、 読み込みたいＨＴＭＬファイルがUTF-8です。 文字化けしてしますのですが、どうしたらよいでしょうか？ Option Explicit Sub sample2() Dim f As Variant Dim lines() As String Dim c As Integer Cells.Clear c = 1 f = Dir("C:\実験\*.html") Do While f <> "" With CreateObject("Scripting.FileSystemObject").GetFile("C:\実験\" & f).OpenAsTextStream lines = Split(.ReadAll, vbCrLf) .Close End With Cells(1, c).Resize(UBound(lines) + 1, 1).Value = WorksheetFunction.Transpose(lines) f = Dir c = c + 1 Loop End Sub どこかに With CreateObject("ADODB.Stream") End With を入れたらいいのでしょうか？
- ベストアンサー
- その他（プログラミング・開発）
- 配列 変数の宣言 ＶＢＡ
こんばんは。 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でTransposeの不思議
MS Officeのエクセル2000です。 下記Sub test01はRange("A1:I1")に文字列を入力し、一旦配列に取り込んでからワークシートに貼り付けるものです。 試験用のコードですので意味はありません。 このコードで255文字まではまったく問題はありません。 ところが、256文字以上の場合、横に貼り付けは問題ないのですが、 Transposeで縦に変換すると型が一致しません。(Error 13)となります。 どうしてでしょうか？ 試行錯誤の結果、Sub test02のように一旦横に貼ったデータをコピーしてTransposeして貼り付けるのは大丈夫のようですので不思議でしょがありません。 またこの方法は列数256より要素が多い配列には使えないので解決策にはなりません。 ご教示くださいませ。 Sub test01() Dim myAr As Variant Dim i As Integer, n As Integer n = 256 '文字数 With ActiveSheet .UsedRange.ClearContents For i = 1 To 9 .Cells(1, i).Value = Application.Rept(Left(.Cells(1, i).Address(0, 0), 1), n) Next myAr = .Range("A1:I1").Value .Range("A3").Resize(, UBound(myAr, 2)).Value = myAr .Range("A5").Resize(UBound(myAr, 2)).Value = Application.Transpose(myAr) '256文字の場合エラー End With End Sub Sub test02() Dim myAr As Variant Dim i As Integer, n As Integer n = 256 '文字数 With ActiveSheet .UsedRange.ClearContents For i = 1 To 9 .Cells(1, i).Value = Application.Rept(Left(.Cells(1, i).Address(0, 0), 1), n) Next myAr = .Range("A1:I1").Value .Range("A3").Resize(, UBound(myAr, 2)).Value = myAr .Range("A3").Resize(, UBound(myAr, 2)).Copy .Range("A5").PasteSpecial Paste:=xlValues, Transpose:=True '256文字の場合もOK Application.CutCopyMode = False End With End Sub
- ベストアンサー
- その他MS Office製品
- EXCEL VBAの配列でわかりません。
こんなコードがあるのですが、最後の他のシート（作業中シート）に書き込もうとするとエラーになってしまいます。”Sheets("作業中").”を抜くと同じシートに結果は返ってくるのですが…。コードの内容は、ある範囲のある列から空白ではないセルを探し出してその行のデータを配列で汲み取り、他のシートに一括で洗い出すというものです。 Sub 作業中() Dim myRow As Long Dim Data As Variant Dim WC() As Variant Dim WCE() As Variant myRow = Range("H1").CurrentRegion.Rows.Count Data = Range("H1:M" & myRow).Value For i = 1 To myRow If Data(i, 5) <> "" Then a = a + 1 Else b = b + 1 End If Next ReDim WC(a) ReDim WCE(b) c = 0 d = 0 For i = 1 To myRow If Data(i, 5) <> "" Then WC(c) = Range("H" & i & ":K" & i).Value c = c + 1 Else WCE(d) = Range(Cells(i, 8), Cells(i, 11)).Value d = d + 1 End If Next For i = 0 To a Range(Cells(i + 1, 15), Cells(i + 1, 18)).Value = WC(i) Next For i = 0 To b Range(Cells(i + 1, 19), Cells(i + 1, 22)).Value = WCE(i) Next e = Range(Cells(1, 15), Cells(a, 18)).Value Sheets("作業中").Range(Cells(1, 1), Cells(a, 4)).Value = e End Sub ちなみに同じシートから↓のコードを実行するとうまくいきます。 なぜ～？？わからな～い？？おしえてくださーい！！ Sub test() Dim a As Variant a = Range("H1:K4") Sheets("作業中").Range("N1:Q4") = a End Sub
- ベストアンサー
- オフィス系ソフト
- [VBA]二次元配列を使ったsumif
こちらの識者の方々にはいつもお世話になっています。 VBAの質問です。 環境は下記になります。 OS=windowsXP SP3 Office=Excel2003(11.8347.8403) SP3 vbaでワークシート関数でいうsumifにあたる計算をしたいのですが、自分なりに二次元配列でコードを書いたものの、それでも時間がかかりすぎるため質問させていただきます。 :Sheet1 4月 5月 6月 7月 りんご 20 10 31 みかん 50 40 20 バナナ 35 15 20 りんご 52 50 65 ぶどう 32 63 みかん 21 23 50 のようなデータが約40,000行存在します。 これをSheet2に 4月 5月 6月 7月 りんご 20 62 81 65 みかん 71 0 63 70 バナナ 35 15 20 0 ぶどう 0 0 32 63 のような形で集計したいのです。 自分で書いたコードは下記です。 Option Explicit Option Base 1 Sub test() Dim SourAry As Variant Dim DestAry As Variant Dim SourEndRow As Long Dim DestEndRow As Long Dim i As Long Dim j As Long Dim k As Long Dim TTL As Long Application.ScreenUpdating = False SourEndRow = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row DestEndRow = Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row SourAry = Sheets("Sheet1").Range("A2:E" & SourEndRow).Value DestAry = Sheets("Sheet2").Range("A2:E" & DestEndRow).Value For i = 2 To 5 For j = 1 To UBound(DestAry) For k = 1 To UBound(SourAry) If SourAry(k, 1) = DestAry(j, 1) Then TTL = TTL + SourAry(k, i) DestAry(j, i) = TTL Next k TTL = 0 Next j Next i Sheets("Sheet2").Range("A2:E" & DestEndRow).Value = DestAry Application.ScreenUpdating = True End Sub これでも一応希望通りの結果は得られるのですが、40,000行ともなると配列で処理したとしてもとても時間がかかってしまいます。 ご教示いただきたいことは、もっと効率のいいコードなのですが、実は実際のデータはSheet1とSheet2のA列のデータは昇順で並んでおります。 後学のためにもしよろしければ下記2パターンを教えて戴けませんでしょうか。 1.キーとなるフィールドが昇順で並んでいる場合 2.キーとなるフィールドの順番がばらばらで、かつ並び替えることができない場合（A列総当たり） 2.のパターンの場合、コードによると思いますが、総当たりよりかはやはり並び替えた方が効率はいいものなのでしょうか？ 質問に不備不足等ございましたらご指摘ください。 ご面倒お掛けしますがよろしくお願いします。
- ベストアンサー
- Excel（エクセル）
- エクセルVBAの文字列操作について2
エクセルVBAの文字列操作について2 以前、こちらでご教授いただいた以下のような文字列操作方法があります。 この方法ですと例えば[1-3]から3をひいた際に"1-2"と表示されますが 今回は連続する数字が2つの場合は1,2と表示させ3つ以上の場合は-でつないで表示させたいと思います。 一週間ほど考えたのですが解決できませんでした。 どなたかご協力お願いいたします。 質問内容 例えば、[１－１０,15-20,22-38]と入っているセルがあるとします。 このセルに数を足したり引いたりしたいのです。 例えば、このセルから”5”を引いて[１-4,6-１０,15-20,22-38]と表示したり、 "21"を足して[１－１０,15-38]と表示したい。 いただいたご回答 A1 セル に「1-10,12,15-20,22-38」と入力されているとして、別のセルに =NUMORDER(A1,-5) と入力すると「1-4,6-10,12,15-20,22-38」と表示し =NUMORDER(A1,21) と入力すると「1-10,12,15-38」と表示します。 １つ目の引数には「セル番地」または「文字列」を、２つ目の引数には「1 ～ 99 までの整数」をお入れください。 Function NUMORDER(myStr As Variant, num As Integer) As String Dim i As Long Dim j As Double Dim myNum As Variant '文字列中の スペース を削除 myStr = Replace(myStr, " ", "") '文字列の前後に「0」・「100」を挿入 Select Case Left(myStr, 2) Case "1,", "1-" myStr = myStr & ",100" Case Else myStr = "0," & myStr & ",100" End Select '文字列を カンマ で分割し、ハイフン の区間の数字を補完する myStr = Split(myStr, ",") For i = 0 To UBound(myStr) If InStr(myStr(i), "-") > 0 Then myNum = Split(myStr(i), "-") myStr(i) = "" For j = myNum(0) To myNum(1) myStr(i) = myStr(i) & " " & j Next myStr(i) = Trim(myStr(i)) End If Next '欠番に「●」を入れ、「数を足したり引いたり」する myStr = Split(Join(myStr)) For i = 0 To UBound(myStr) - 1 myStr(i) = myStr(i) & Application.WorksheetFunction.Rept(" ●", myStr(i + 1) - myStr(i) - 1) Next myStr = Split(Join(myStr)) If num > 0 Then myStr(num - myStr(0)) = num Else myStr(-num - myStr(0)) = "●" End If '前後に挿入した「0」・「100」を削除 myStr = Replace(Join(myStr), " 100", "") If Left(myStr, 2) = "0 " Then myStr = Right(myStr, Len(myStr) - 2) '連続数字を ハイフン で繋ぐ myStr = Split(myStr, "●") For i = 0 To UBound(myStr) If myStr(i) <> " " Then myNum = Split(Trim(myStr(i))) If UBound(myNum) > 0 Then myStr(i) = myNum(0) & "-" & myNum(UBound(myNum)) End If End If Next 'カンマ で文字列に分割する myStr = Application.Trim(Join(myStr)) NUMORDER = Replace(myStr, " ", ",") End Function
- 締切済み
- オフィス系ソフト
- vbaでCountIf関数を使いたい（エクセル）
A1セルにa-a-aがはいっています。 この場合aは３つですよね。 これをvbaで取得するコードを作っているのですがうまくできません。 Sub test() Dim myStr As String myStr = "a" MsgBox WorksheetFunction.CountIf(Cells(1, 1), "*" & myStr & "*") End Sub これをすると、なぜか１が返ってきます。 Aは３つあるのになぜ１が返るのでしょうか？ A1にaaaaaを入れて実行しても1が返ります。
- ベストアンサー
- オフィス系ソフト
お礼
まさか！！！ だめもとで質問してみたのですが、できました！！ すごいです！びっくりです！ ありがとうございます。 ちなみに「 "\(\d+\)"」はどういう意味なのでしょうか？ VBScript関連でしょうか？