Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


66612 / 76738 ←次へ | 前へ→

【14689】Re:セルの文字列データの種類分けVBAコード
発言  ichinose  - 04/6/4(金) 18:21 -

引用なし
パスワード
   ▼しん さん:
こんばんは。

>とあるwebサイトの質問箱に
>
>A      B
>1行燈    芥川10,鴎外157
>2囲炉裏   独歩31,谷崎55
>3囲炉裏   独歩96
>4鵜飼い鴎外26
>5お社鴎外17
>
>というテーブルがあって、これを
>
>A      B
>1行燈    芥川10,鴎外157
>2囲炉裏   独歩31,96,谷崎55
>3鵜飼い鴎外26
>4お社鴎外17
>
>のように並び替えしたいという質問がありましたが、これなどもichinoseさんの魔術にかかれば簡単に解決できるのでしょうね!
簡単ではありませんよ!!
ただ、文字列解析と言うのは、最終的には一文字ずつチェックしていけば
何とかなりそうですよね?

上記の問題は、「おまけ」みたいなもののようですから、
一部だけ・・・。

この問題の入力データの2行目、3行目の「囲炉裏」のB列

「独歩31,谷崎55,独歩96」とまとめるのはガチャガチャ(←表現難しい?)
すれば何とかなりそうですよね・・・。


では、ここから、-----「独歩31,96,谷崎55」に加工するとこだけ。
これだったら、ここで投稿したプロシジャーを使えば何とかなるもので・・。
'====================================================================
Sub test()
  Dim ans() As String
  Dim sep1() As String
  Dim sep2() As String
  Dim ques_str As String
  Dim moto_array() As String
  Dim s_clct As Collection
  ques_str = "独歩31,谷崎55,独歩96,独歩100,谷崎98" '入力データ
  Call 文字列分解(ques_str, sep1(), "[0-9]+") '半角数字を取り出す
  no_num = ques_str
  For idx = LBound(sep1()) To UBound(sep1())
   no_num = replace(no_num, sep1(idx), "") '数字のない文字列作成
   Next
  moto_array() = Split(ques_str, ",") '元データをカンマ分割
  sep2() = Split(no_num, ",") '数字のないデータをカンマ分割
  Set s_clct = mk_unique_collection(sep2()) '重複なし作成
  kdx = 0
  For idx = 1 To s_clct.Count
   wk = Filter(moto_array(), s_clct.Item(idx))
   For jdx = LBound(wk) To UBound(wk)
     ReDim Preserve ans(1 To kdx + 1)
     If jdx = LBound(wk) Then
      ans(kdx + 1) = wk(jdx)
     Else
      ans(kdx + 1) = replace(wk(jdx), s_clct.Item(idx), "")
      End If
     kdx = kdx + 1
     Next jdx
   Next idx
  If kdx > 0 Then
   MsgBox Join(ans(), ",") '出力データ表示
   End If
End Sub
'=================================================================
Sub 文字列分解(strng, a_array() As String, pat As String)
'文字列分解というプロシジャーをちょっと拡張しました
'(というより、私の元コレクションはこっち)

  Dim regEx, Match, Matches  ' 変数を作成します。
  Set regEx = CreateObject("VBScript.RegExp")
  ' 正規表現を作成します。
  regEx.Pattern = pat
  regEx.IgnoreCase = True ' 大文字と小文字を区別しないように設定します。
  regEx.Global = True  ' 文字列全体を検索するように設定します。
  Set Matches = regEx.Execute(strng)  ' 検索を実行します。
  idx = 1
  For Each Match In Matches  ' Matches コレクションに対して繰り返し処理を行います。
   ReDim Preserve a_array(1 To idx)
   a_array(idx) = Match.Value
   idx = idx + 1
  Next
  Set regEx = Nothing
  Set Match = Nothing
  Set Matches = Nothing
End Sub
'=================================================================
Function mk_unique_collection(myarray() As String)
  Dim myclct As New Collection
  On Error Resume Next
  For idx = LBound(myarray()) To UBound(myarray())
   myclct.Add myarray(idx), myarray(idx)
   Next
  Set mk_unique_collection = myclct
  Set myclct = Nothing
  On Error GoTo 0
End Function

簡単なデータならOKだと思います。
Filter関数を使ってますから、また、漏れが心配だけど、
ダメならひとつづつチェックするしかないでしょうね!!

前半は、しんさん 考えてみて下さい。

0 hits

【14569】セルの文字列データの種類分けVBAコード しん 04/6/2(水) 2:37 質問
【14570】Re:セルの文字列データの種類分けVBAコード ichinose 04/6/2(水) 7:46 回答
【14575】Re:セルの文字列データの種類分けVBAコード しん 04/6/2(水) 10:31 回答
【14609】Re:セルの文字列データの種類分けVBAコード しん 04/6/3(木) 2:15 質問
【14612】Re:セルの文字列データの種類分けVBAコード ichinose 04/6/3(木) 8:12 発言
【14641】Re:セルの文字列データの種類分けVBAコード ichinose 04/6/3(木) 18:41 発言
【14669】Re:セルの文字列データの種類分けVBAコード しん 04/6/4(金) 0:45 お礼
【14689】Re:セルの文字列データの種類分けVBAコード ichinose 04/6/4(金) 18:21 発言
【14695】Re:セルの文字列データの種類分けVBAコード しん 04/6/5(土) 2:52 回答
【14698】Re:セルの文字列データの種類分けVBAコード しん 04/6/5(土) 12:07 回答

66612 / 76738 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free