[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『VBA：文字列の分割＆まとめる』（わからず）
仕事でいきずまってしまいました。どなたか良いご回答お願いします。
＜したいこと＞
A B 1 A1-3,5,AB1-5 2 R1-5,7,9,C5,FL1-5 ・ ・ ・ ・ ・ ・
とゆーよーなデータがずらっとありこのデータを
A B 1 A1-3,5 1.01 AB1-5 2 R1-5,7,9 2.01 C5 2.02 FL1-5
となるように作成したいのですが、現在のコードでは
A B 1 A1-3,5 1.01 A1-5 2 R1-5,7,9 2.01 R5 2.02 R1-5
と表示されてしまいます。コードをのせますので、良いアドバイスをお願いします。
※B列のデータはもっと長いのもあれば、短いのもありとさまざまです。
Range("A2").Select
Do While ActiveCell <> ""
Selection.Offset(0, 1).Select
roke = ActiveCell.Value
Nagasa = Len(roke)
Mijissou = "": MijissouL = "": MijissouR = ""
For i = 2 To Nagasa
If Val(Right(Left(roke, i), 1)) <> 0 Then Exit For
Next
Kategori = Left(roke, i - 1)
If Left(roke, 1) = "<" Then _
Mijissou = "<": MijissouL = "<": MijissouR = ">"
If Nagasa >= 40 Then
Selection.Offset(0, -1).Select
Koumoku = ActiveCell.Value
Koumoku = Koumoku + 0.01
Selection.Offset(1, 0).Select
ActiveWindow.SmallScroll Down:=1 '行の追加
Selection.EntireRow.Insert '行の追加
ActiveCell.Value = Koumoku '項目の追加（例：53.1）
For i = 0 To 37
A = Left(roke, 38 - i)
B = Right(A, 1)
If B = "," Then Exit For
Next
Selection.Offset(-1, 1).Select
If Left(Left(roke, 38 - i - 1), 1) = "<" Then MijissouL = ""
If Right(Left(roke, 38 - i - 1), 1) = ">" Then MijissouR = ""
ActiveCell.Value = MijissouL & Left(roke, 38 - i - 1) & MijissouR
roke = Right(roke, Nagasa - 38 + i)
Selection.Offset(1, 0).Select
ActiveCell.Value = Kategori & roke
Selection.Offset(-1, 0).Select
End If
Selection.Offset(1, -1).Select
Loop
ご教授よろしくお願いします。
見づらかったので、勝手に修正〜
（ramrun）
上のコードで上のデータですと、わからずさんがいうような 結果になりませんね。 コードを読んでみても、そういう結果以前にいろいろあるんですけど それは置いといて。
とりあえずMijissouの扱いが不明ですが、 極力、わからずさんのコードを残す形で修正してみました。 （ramrun）
Sub macro()
Range("A2").Select
Do While ActiveCell <> ""
Selection.Offset(0, 1).Select
roke = ActiveCell.Value
Nagasa = Len(roke)
MijissouL = 0: MijissouR = 0
For i = 2 To Nagasa
If Val(Right(Left(roke, i), 1)) <> 0 Then Exit For
Next
Kategori = Left(roke, i - 1)
For i = 1 To Len(roke)
If Mid(roke, i, 1) = "," Then
exec = True
Exit For
Else
exec = False
End If
Next
If exec Then
Selection.Offset(0, -1).Select
Koumoku = ActiveCell.Value
Koumoku = Koumoku + 0.01
Selection.Offset(1, 0).Select
ActiveWindow.SmallScroll Down:=1
Selection.EntireRow.Insert
ActiveCell.Value = Koumoku
For i = 1 To Len(roke)
A = Left(roke, i)
B = Right(A, 1)
If B = "," Then
If Not IsNumeric(Mid(roke, i + 1, 1)) Then
Exit For
End If
ElseIf i = Len(roke) Then
Exit For
End If
Next
Selection.Offset(-1, 1).Select
If Left(roke, 1) = "<" Then MijissouL = 1
If Right(Left(roke, i - 1), 1) = ">" Then MijissouR = 1
strcnt = i - 1 - MijissouL
ActiveCell.Value = Right(Left(roke, strcnt), strcnt - MijissouR)
roke = Right(roke, Nagasa - i)
Selection.Offset(1, 0).Select
ActiveCell.Value = roke
Selection.Offset(-1, 0).Select
End If
Selection.Offset(1, -1).Select
Loop
End Sub
お〜、師匠に先越されてしまったで。
わたしゃ他人様のコードを読みとる理解力も根気もおまへんのんで、弥太郎流のコード
を作ってみましたわ。
A1から下へデータが並んどって、E,F列に結果をアウトプットする仕様になっとります
さかい、必要に応じてご自分の適用範囲へコードを書き換えてくだはい。
ほな...（弥太郎）
'---------------------------
Sub kubn()
Dim i As Integer, t As Integer, n As Integer, y As Integer
Dim maxrow As Long
Dim grup() As Variant
For i = 1 To Range("a65536").End(xlUp).Row
t = 0
ReDim Preserve grup(t)
f = Split(Cells(i, 2), ",", -1)
grup(t) = f(0)
For n = 1 To UBound(f)
ReDim Preserve grup(t)
If IsNumeric(f(n)) Then
grup(t) = grup(t) & "," & f(n)
Else
t = t + 1
ReDim Preserve grup(t)
grup(t) = f(n)
End If
Next n
maxrow = Range("e65536").End(xlUp).Row + 1
For y = 0 To UBound(grup)
If y = 0 Then
If maxrow = 2 Then
maxrow = maxrow - 1
End If
Cells(maxrow + y, 5) = "'" & i
Else
Cells(maxrow + y, 5) = "'" & i & "." & "0" & y
End If
Cells(maxrow + y, 6) = grup(y)
Next y
Next i
End Sub
1 FL9001-9002,9101 1.01 FB3502-3504,4101 1.02 4101-4102 1.03 4502-4503 1.04 4801-4802 1.05 4901-4906
とゆー結果になります。
1.02以降にも頭にFBとつけたいのですが・・・ご教授お願いしますm(_ _)m
後、ここに書き込みをする際プレビューを押すと、表示が書き込みと変わって
文字が大きくなったり、しますがどうすればよいのですか？
(わからず)
私のほうはexecの条件が適当すぎたみたいですね。
お。 kategoriってそのためにあったんですか。 それで mijissou の扱いは？
弥太郎さんのコードでは
Cells(maxrow + y, 6) = grup(y)
がデータの出力ですから、そこにご自分で考えられた
For i = 2 To Nagasa
If Val(Right(Left(roke, i), 1)) <> 0 Then Exit For
Next
Kategori = Left(roke, i - 1)
を組み込んでみては？ （ramrun）
mijissouはその後のコードをみても使用していなかったので、削除したいと思います。
＞がデータの出力ですから、そこにご自分で考えられた
申し訳ないです・・・他の人が組んだものを修正させられているので・・・
いまいち理解ができていないです。教えていただけないでしょうか？m(_ _)m
(わからず)
>他の人が組んだものを修正させられている
冷たいようですが、そんなことは私には関係ないことです。 あなた自身が自分でやる気があるのかどうかです。
とりあえず Cells(maxrow + y, 6) = grup(y)
のところを↓のようにしてみてください。 Kategoriのコードを組み込んだだけなので、 条件を見直さなければいけないかもしれません。 （ramrun）
For n = 2 To Len(grup(y))
If Val(Right(Left(grup(y), n), 1)) <> 0 Then Exit For
Next
If IsNumeric(Left(grup(y), 1)) Then
grup(y) = kategori & grup(y)
Else
kategori = Left(grup(y), n - 1)
End If
Cells(maxrow + y, 6) = grup(y)
ふがいない弟子の尻ぬぐいご苦労はんです。（笑） 最初に貰うた情報には4000-4001等数値同士がハイフンで繋がってるなんぞおまへん でしたもんで・・・、いちゃもんは（わからず）さんの方へどうぞ。
今申しました通り4000-4001にも英語をつけて拾うように書き換えときますた。
ほんなら...（弥太郎）
'-------------------------
Sub kubn()
Dim i As Integer, t As Integer, n As Integer, y As Integer
Dim maxrow As Long
Dim grup() As Variant
For i = 1 To Range("a65536").End(xlUp).Row
t = 0
ReDim Preserve grup(t)
f = Split(Cells(i, 2), ",", -1)
grup(t) = f(0)
For n = 1 To UBound(f)
ReDim Preserve grup(t)
If IsNumeric(f(n)) Then
grup(t) = grup(t) & "," & f(n)
Else
If Not IsError(Split(f(n), "-")) And IsNumeric(Left(f(n), 1)) Then
t = t + 1
ReDim Preserve grup(t)
grup(t) = get_strg(grup, t) & f(n)
Else
t = t + 1
ReDim Preserve grup(t)
grup(t) = f(n)
End If
End If
Next n
maxrow = Range("e65536").End(xlUp).Row + 1
For y = 0 To UBound(grup)
If y = 0 Then
If maxrow = 2 Then
maxrow = maxrow - 1
End If
Cells(maxrow + y, 5) = "'" & i
Else
Cells(maxrow + y, 5) = "'" & i & "." & "0" & y
End If
Cells(maxrow + y, 6) = grup(y)
Next y
Next i
End Sub
'-----------------------------------
Function get_strg(ByVal grup As Variant, ByVal t As Integer) As String
Dim i As Integer
For i = 1 To 2
If Not IsNumeric(Mid(grup(t - 1), i, 1)) Then
get_strg = get_strg & Mid(grup(t - 1), i, 1)
Else
Exit Function
End If
Next i
End Function
（わからず）さん、遅うなってごめんなはれや。 例によってケンショウブソクですわ、はい。（汗） If maxrow=2 Thenを If Cells(1,5)="" Then に変えておくんなはれ。 これでいけるとおもいまっせ。タブン・・・。 あかんかったらまたカキコしとってくだはい。アスの夜になります。 ほな...(弥太郎）
現在の出力結果は
A B
1 TP3205-3206
1.01 TP4502-4503
2 TP3205-3206
3 TP3205-3206
4 TP3205-3206
5 TP3205-3206
5.01 TP4502-4503
となります。
A B
1 TP3205-3206
1.01 TP4502-4503
2
3
4
5 TP3205-3206
5.01 TP4502-4503
と出力させれるようにしたいですm(_ _)m
(わからず)
ちょっと、わからず屋はん。 そう言う例示は最初からいうてくれまへんか？ でないと、またコードをいじらなあきまへんさかいなぁ。 はっきり言うて二度手間、三度手間になりまんねんで、えぇ。 が、そこんとこが（わからず）のHNを名乗る所以なんでっしゃろけどなぁ。（笑）
余談はさておいて
下のコードに書き換えてくだはい。
ほな...次は何が出てくるんやろ（弥太郎）
'---------------------------------
Sub kubn()
Dim i As Integer, t As Integer, n As Integer, y As Integer
Dim maxrow As Long
Dim grup() As Variant
For i = 1 To Range("a65536").End(xlUp).Row
flag = False
t = 0
ReDim Preserve grup(t)
If Cells(i, 2) <> "" Then
f = Split(Cells(i, 2), ",", -1)
grup(t) = f(0)
For n = 1 To UBound(f)
ReDim Preserve grup(t)
If IsNumeric(f(n)) Then
grup(t) = grup(t) & "," & f(n)
Else
If Not IsError(Split(f(n), "-")) And IsNumeric(Left(f(n), 1)) Then
t = t + 1
ReDim Preserve grup(t)
grup(t) = get_strg(grup, t) & f(n)
Else
t = t + 1
ReDim Preserve grup(t)
grup(t) = f(n)
End If
End If
Next n
Else
flag = True
Cells(Range("e65536").End(xlUp).Row + 1, 5) = "'" & Cells(i, 1)
End If
If flag = False Then
maxrow = Range("e65536").End(xlUp).Row + 1
For y = 0 To UBound(grup)
If y = 0 Then
If Cells(1, 5) = "" Then
maxrow = maxrow - 1
End If
Cells(maxrow + y, 5) = "'" & i
Else
Cells(maxrow + y, 5) = "'" & i & "." & "0" & y
End If
Cells(maxrow + y, 6) = grup(y)
Next y
End If
Next i
End Sub
'-----------------------------------
Function get_strg(ByVal grup As Variant, ByVal t As Integer) As String
Dim i As Integer
For i = 1 To 2
If Not IsNumeric(Mid(grup(t - 1), i, 1)) Then
get_strg = get_strg & Mid(grup(t - 1), i, 1)
Else
Exit Function
End If
Next i
End Function
>嫌気をささずにご回答よろしくお願いします 別に嫌気が差しとるわけやおまへんでぇ、えぇ。 これは、はい、私のミスショットですさかいナ。喜んで修正させて貰いますワ。 お互いミスショットの連発で、まぁ、イーブンっちゅうとこでんな。（笑） 長うなるんで上のコードを差し替えときました。 試してみておくんなはれ。 ほな...（弥太郎）
A B
1 A1,3,5,10-13,B1,3,5,10-3
とデータがある場合、
A B
1 A1,A3,A5,A10,A11,A12,A13,B1,B3,B5,B10,B11,B12,B13
と出力させるようにしたいのですが・・・
ご回答よろしくお願いしますm(_ _)m
あのねえ（わからず）さん。 申し訳おまへんけど http://ryusendo.no-ip.com/cgi-bin/fswiki/wiki.cgi?page=%CC%EF%C2%C0%CF%BA%A4%CE%C9%F4%B2%B0 に弥太郎の部屋ッちゅうんがありますさかいナ、そこへあらゆるデータを書き込んで それをどうしたいんかを書いてくれしまへんか？ 現状ではなんやら規則性がのうなってきとるみたいなんで、また新しい問題が発生 しかねまへんやろ？ せやさかい、あそこやったらどんなに長うなってもかめしまへんから洗いざらいの データパターンを書き込んでくだみてはい。編集ででけますさかいナ。 念のために申し上げときますけどわたしゃ至って優しいにんげんですさかい、身構える 必要はおまへんでぇ。（笑） ほな...（弥太郎）
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.