Excel VBA質問箱 IV

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

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


11179 / 13646 ツリー ←次へ | 前へ→

【17647】文字列のカンマ区切りとワークシート表のセル並び替え しん 04/9/4(土) 0:13 質問[未読]
【17650】Re:文字列のカンマ区切りとワークシート表... Kein 04/9/4(土) 1:08 回答[未読]
【17670】Re:文字列のカンマ区切りとワークシート表... しん 04/9/4(土) 19:07 質問[未読]
【17673】Re:文字列のカンマ区切りとワークシート表... かみちゃん 04/9/4(土) 19:37 回答[未読]
【17676】Re:文字列のカンマ区切りとワークシート表... しん 04/9/4(土) 20:36 質問[未読]
【17677】Re:文字列のカンマ区切りとワークシート表... かみちゃん 04/9/4(土) 20:55 回答[未読]
【17681】Re:文字列のカンマ区切りとワークシート表... しん 04/9/4(土) 21:57 質問[未読]
【17682】Re:文字列のカンマ区切りとワークシート表... かみちゃん 04/9/4(土) 22:18 発言[未読]
【17683】Re:文字列のカンマ区切りとワークシート表... かみちゃん 04/9/4(土) 22:41 回答[未読]
【17684】Re:文字列のカンマ区切りとワークシート表... Kein 04/9/4(土) 22:50 回答[未読]
【17685】Re:文字列のカンマ区切りとワークシート表... Kein 04/9/4(土) 22:56 回答[未読]
【17686】Re:文字列のカンマ区切りとワークシート表... Kein 04/9/4(土) 23:00 発言[未読]
【17687】Re:文字列のカンマ区切りとワークシート表... かみちゃん 04/9/4(土) 23:08 発言[未読]
【17688】Re:文字列のカンマ区切りとワークシート表... Kein 04/9/4(土) 23:42 発言[未読]
【17690】Re:文字列のカンマ区切りとワークシート表... Kein 04/9/4(土) 23:48 回答[未読]
【17691】Re:文字列のカンマ区切りとワークシート表... しん 04/9/4(土) 23:59 お礼[未読]
【17678】Re:文字列のカンマ区切りとワークシート表... Kein 04/9/4(土) 21:23 回答[未読]
【17654】Re:文字列のカンマ区切りとワークシート表... かみちゃん 04/9/4(土) 11:30 回答[未読]
【17671】Re:文字列のカンマ区切りとワークシート表... かみちゃん 04/9/4(土) 19:25 回答[未読]
【17674】Re:文字列のカンマ区切りとワークシート表... しん 04/9/4(土) 19:58 質問[未読]
【17675】Re:文字列のカンマ区切りとワークシート表... かみちゃん 04/9/4(土) 20:29 回答[未読]
【17680】Re:文字列のカンマ区切りとワークシート表... かみちゃん 04/9/4(土) 21:30 回答[未読]
【17692】Re:文字列のカンマ区切りとワークシート表... しん 04/9/5(日) 0:04 お礼[未読]
【17672】Re:文字列のカンマ区切りとワークシート表... しん 04/9/4(土) 19:36 質問[未読]

【17647】文字列のカンマ区切りとワークシート表の...
質問  しん E-MAIL  - 04/9/4(土) 0:13 -

引用なし
パスワード
   文字列のカンマ区切りによる文字列分解とワークシート表のセル並び替えについて教えて下さい。

たとえば、下記のような罫線付きExcel表(ワークシートSheet1)

┌─┬─┬───┐
│A │B │C   │
├─┼─┼───┤
│1 │あ│a   │
├─┼─┼───┤
│2 │い│   │
├─┼─┼───┤
│3 │う│b,c  │
├─┼─┼───┤
│4 │え│d   │
├─┼─┼───┤
│5 │お│e,f,g │
└─┴─┴───┘

を下記のような罫線付きExcel表(ワークシートSheet2)

┌─┬─┬───┐
│A │B │C   │
├─┼─┼───┤
│1 │あ│a   │
├─┼─┼───┤
│2 │い│   │
├─┼─┼───┤
│3 │う│b   │
├─┼─┼───┤
│3 │う│c   │
├─┼─┼───┤
│4 │え│d   │
├─┼─┼───┤
│5 │お│e   │
├─┼─┼───┤
│5 │お│f   │
├─┼─┼───┤
│5 │お│g   │
└─┴─┴───┘

に自動的に変換するVBAコードを教えて頂きたいのですが、よろしくお願いします。ただし、行と列の数は任意とします。要は最終列にあるカンマ区切りのデータを分離して、そのデータ数に応じた数だけ行を増やしたいんです。

【17650】Re:文字列のカンマ区切りとワークシート...
回答  Kein  - 04/9/4(土) 1:08 -

引用なし
パスワード
   Sub MyData_Split()
  Dim i As Long, j As Long
  Dim Ary1() As String, Ary2() As String
  Dim SpAry As Variant, V As Variant
 
  With Sheets("Sheet1")
   For i = 1 To .Range("A1").End(xlDown).Row
     If IsEmpty(.Cells(i, 2).Value) Then
      ReDim Preserve Ary1(j): Ary1(j) = .Cells(i, 1).Value
      ReDim Preserve Ary2(j): Ary2(j) = ""
      j = j + 1
     Else
      If Len(.Cells(i, 2).Value) = 1 Then
        ReDim Preserve Ary1(j): Ary1(j) = .Cells(i, 1).Value
        ReDim Preserve Ary2(j): Ary2(j) = .Cells(i, 2).Value
        j = j + 1
      Else
        SpAry = Split(.Cells(i, 2).Value, ",")
        For Each V In SpAry
         ReDim Preserve Ary1(j): Ary1(j) = .Cells(i, 1).Value
         ReDim Preserve Ary2(j): Ary2(j) = V
         j = j + 1
        Next
        Erase SpAry
      End If
     End If
   Next i
  End With
  With Sheets("Sheet2")
   .Cells(1, 1).Resize(UBound(Ary1) + 1).Value = _
   WorksheetFunction.Transpose(Ary1)
   .Cells(1, 2).Resize(UBound(Ary2) + 1).Value = _
   WorksheetFunction.Transpose(Ary2)
   .Cells(1, 1).CurrentRegion.Borders.LineStyle = 1
  End With
  Erase Ary1, Ary2
End Sub

で、どうかな ?

【17654】Re:文字列のカンマ区切りとワークシート...
回答  かみちゃん  - 04/9/4(土) 11:30 -

引用なし
パスワード
   こんにちは。かみちゃん です。

すでにKeinさんからもコメントが出ていますが、前回のコードの変更をすればできますので、ご紹介したいと思います。
前回、提示しましたコードは以下のとおりです。
http://www.vbalab.net/vbaqa/c-board.cgi?cmd=one;no=17548;id=excel

今回の修正にあたって、以下の変数の宣言を追加してください。
  Dim MaxRow As Long, RowNo As Long, ColumnNo As Integer

そして、前回提示したコードの中に以下のコードがあると思います。

>  '変形後の表の大きさを取得
>  MaxColumn = Range("A1").CurrentRegion.Columns.Count

この下に以下のコードを挿入してください。

  MaxRow = Range("A1").CurrentRegion.Rows.Count
  '変形処理(列方向へ挿入したセルを行方向へ展開)
  RowNo = 2
  Do Until RowNo > MaxRow
   For ColumnNo = 2 To MaxColumn
    If Cells(RowNo, ColumnNo).Value <> "" Then
     If ColumnNo > 2 Then
      Rows(RowNo).Copy
      Rows(RowNo + 1).Insert Shift:=xlDown
      RowNo = RowNo + 1
      MaxRow = MaxRow + 1
      Application.CutCopyMode = False
      Cells(RowNo - 1, ColumnNo).Copy Destination:=Cells(RowNo, 2)
     End If
    Else
     Exit For
    End If
   Next
   RowNo = RowNo + 1
  Loop
  '列方向へ挿入した列全体を削除
  Range(Columns(3), Columns(MaxColumn)).Delete Shift:=xlToLeft

これで、ご希望の展開ができると思います。(動作確認済み)

【17670】Re:文字列のカンマ区切りとワークシート...
質問  しん E-MAIL  - 04/9/4(土) 19:07 -

引用なし
パスワード
   ▼Kein さん:

こんばんは、さっそく教えて頂いたVBAコード

>Sub MyData_Split()
>  Dim i As Long, j As Long
>  Dim Ary1() As String, Ary2() As String
>  Dim SpAry As Variant, V As Variant
> 
>  With Sheets("Sheet1")
>   For i = 1 To .Range("A1").End(xlDown).Row
>     If IsEmpty(.Cells(i, 2).Value) Then
>      ReDim Preserve Ary1(j): Ary1(j) = .Cells(i, 1).Value
>      ReDim Preserve Ary2(j): Ary2(j) = ""
>      j = j + 1
>     Else
>      If Len(.Cells(i, 2).Value) = 1 Then
>        ReDim Preserve Ary1(j): Ary1(j) = .Cells(i, 1).Value
>        ReDim Preserve Ary2(j): Ary2(j) = .Cells(i, 2).Value
>        j = j + 1
>      Else
>        SpAry = Split(.Cells(i, 2).Value, ",")
>        For Each V In SpAry
>         ReDim Preserve Ary1(j): Ary1(j) = .Cells(i, 1).Value
>         ReDim Preserve Ary2(j): Ary2(j) = V
>         j = j + 1
>        Next
>        Erase SpAry
>      End If
>     End If
>   Next i
>  End With
>  With Sheets("Sheet2")
>   .Cells(1, 1).Resize(UBound(Ary1) + 1).Value = _
>   WorksheetFunction.Transpose(Ary1)
>   .Cells(1, 2).Resize(UBound(Ary2) + 1).Value = _
>   WorksheetFunction.Transpose(Ary2)
>   .Cells(1, 1).CurrentRegion.Borders.LineStyle = 1
>  End With
>  Erase Ary1, Ary2
>End Sub
>
で、前掲例題

┌─┬─┬───┐
│A │B │C   │
├─┼─┼───┤
│1 │あ│a   │
├─┼─┼───┤
│2 │い│   │
├─┼─┼───┤
│3 │う│b,c  │
├─┼─┼───┤
│4 │え│d   │
├─┼─┼───┤
│5 │お│e,f,g │
└─┴─┴───┘

を処理してみたのですが

ワークシートSheet2に変換された表は

┌─┬─┐
│A │B │
├─┼─┤
│1 │あ│
├─┼─┤
│2 │い│
├─┼─┤
│3 │う│
├─┼─┤
│4 │え│
├─┼─┤
│5 │お│
└─┴─┘


のようになってしまい、私が望んでいた処理結果

┌─┬─┬───┐
│A │B │C   │
├─┼─┼───┤
│1 │あ│a   │
├─┼─┼───┤
│2 │い│   │
├─┼─┼───┤
│3 │う│b   │
├─┼─┼───┤
│3 │う│c   │
├─┼─┼───┤
│4 │え│d   │
├─┼─┼───┤
│5 │お│e   │
├─┼─┼───┤
│5 │お│f   │
├─┼─┼───┤
│5 │お│g   │
└─┴─┴───┘


のようにはなりませんでした。すみませんが、一度この例題でVBAコードをチェックして頂けませんか?

【17671】Re:文字列のカンマ区切りとワークシート...
回答  かみちゃん  - 04/9/4(土) 19:25 -

引用なし
パスワード
   こんにちは。かみちゃん です。

>これで、ご希望の展開ができると思います。(動作確認済み)

さきほどのKeinさんに対する、しんさんからの質問を見て、私が提示したコードも動作しないことがわかりました。いわゆるバグです。
さきほどのコードのうち、以下の★印の行を修正してください。

   For ColumnNo = 3 To MaxColumn '★
    If Cells(RowNo, ColumnNo).Value <> "" Then
     If ColumnNo > 3 Then '★
      Rows(RowNo).Copy
      Rows(RowNo + 1).Insert Shift:=xlDown
      RowNo = RowNo + 1
      MaxRow = MaxRow + 1
      Application.CutCopyMode = False
      Cells(RowNo - 1, ColumnNo).Copy Destination:=Cells(RowNo, 3) '★
     End If
    Else
     Exit For
    End If
   Next

なお、さきほどのコードも含めてSheet1自身を展開するようにしています。
Sheet2はあらかじめ用意してあるのでしょうか?
最初にSheet1をSheet2にコピーして開始する方法であれば、このコードが使えるのですが、はじめから用意してあるSheet2に展開したいのであれば、かなり手を加えないといけなくなります。

【17672】Re:文字列のカンマ区切りとワークシート...
質問  しん E-MAIL  - 04/9/4(土) 19:36 -

引用なし
パスワード
   ▼かみちゃん さん:
こんばんは、さっそく教えて頂いたVBAコード

>>Option Explicit
>>Sub Macro2()
>>
>>  Dim MaxColumn As Integer, MaxColumnStart As Integer
>  Dim MaxRow As Long, RowNo As Long, ColumnNo As Integer
>>
>>
>>  '変形前の最終列を取得
>>  '表の途中に空白行、空白列がないことが前提
>>  MaxColumn = Range("A1").CurrentRegion.Columns.Count
>>  MaxColumnStart = MaxColumn
>>  '最終列をカンマ区切りで分割
>>  Columns(MaxColumn).Select
>>  Selection.TextToColumns Destination:=Cells(1, MaxColumn), DataType:=xlDelimited, _
>>    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
>>    Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
>>    :=Array(1, 1), TrailingMinusNumbers:=True
>>  '変形後の表の大きさを取得
>>  MaxColumn = Range("A1").CurrentRegion.Columns.Count
>>  
>  MaxRow = Range("A1").CurrentRegion.Rows.Count
>  '変形処理(列方向へ挿入したセルを行方向へ展開)
>  RowNo = 2
>  Do Until RowNo > MaxRow
>   For ColumnNo = 2 To MaxColumn
>    If Cells(RowNo, ColumnNo).Value <> "" Then
>     If ColumnNo > 2 Then
>      Rows(RowNo).Copy
>      Rows(RowNo + 1).Insert Shift:=xlDown
>      RowNo = RowNo + 1
>      MaxRow = MaxRow + 1
>      Application.CutCopyMode = False
>      Cells(RowNo - 1, ColumnNo).Copy Destination:=Cells(RowNo, 2)
>     End If
>    Else
>     Exit For
>    End If
>   Next
>   RowNo = RowNo + 1
>  Loop
>  '列方向へ挿入した列全体を削除
>  Range(Columns(3), Columns(MaxColumn)).Delete Shift:=xlToLeft
>>
>>  '変形後の表全体の罫線処理(マクロの記録により記述)
>>  Range("A1").CurrentRegion.Select
>>  Selection.Borders(xlDiagonalDown).LineStyle = xlNone '※
>>  Selection.Borders(xlDiagonalUp).LineStyle = xlNone '※
>>  With Selection.Borders(xlEdgeLeft)
>>    .LineStyle = xlContinuous
>>    .Weight = xlThin '※
>>    .ColorIndex = xlAutomatic '※
>>  End With
>>  With Selection.Borders(xlEdgeTop)
>>    .LineStyle = xlContinuous
>>    .Weight = xlThin '※
>>    .ColorIndex = xlAutomatic '※
>>  End With
>>  With Selection.Borders(xlEdgeBottom)
>>    .LineStyle = xlContinuous
>>    .Weight = xlThin '※
>>    .ColorIndex = xlAutomatic '※
>>  End With
>>  With Selection.Borders(xlEdgeRight)
>>    .LineStyle = xlContinuous
>>    .Weight = xlThin '※
>>    .ColorIndex = xlAutomatic '※
>>  End With
>>  With Selection.Borders(xlInsideVertical)
>>    .LineStyle = xlContinuous
>>    .Weight = xlThin '※
>>    .ColorIndex = xlAutomatic '※
>>  End With
>>  With Selection.Borders(xlInsideHorizontal)
>>    .LineStyle = xlContinuous
>>    .Weight = xlThin '※
>>    .ColorIndex = xlAutomatic '※
>>  End With
>>  '拡張したタイトル行の修正
>>  Range(Cells(1, MaxColumnStart), Cells(1, MaxColumn)).Select
>>'  Range("C1:E1").Select
>>  Selection.Borders(xlDiagonalDown).LineStyle = xlNone '※
>>  Selection.Borders(xlDiagonalUp).LineStyle = xlNone '※
>>  With Selection.Borders(xlEdgeLeft) '※
>>    .LineStyle = xlContinuous '※
>>    .Weight = xlThin '※
>>    .ColorIndex = xlAutomatic '※
>>  End With '※
>>  With Selection.Borders(xlEdgeTop) '※
>>    .LineStyle = xlContinuous '※
>>    .Weight = xlThin '※
>>    .ColorIndex = xlAutomatic '※
>>  End With '※
>>  With Selection.Borders(xlEdgeBottom) '※
>>    .LineStyle = xlContinuous '※
>>    .Weight = xlThin '※
>>    .ColorIndex = xlAutomatic '※
>>  End With '※
>>  With Selection.Borders(xlEdgeRight) '※
>>    .LineStyle = xlContinuous '※
>>    .Weight = xlThin '※
>>    .ColorIndex = xlAutomatic '※
>>  End With '※
>>  Selection.Borders(xlInsideVertical).LineStyle = xlNone
>>  '拡張したタイトルをセル結合する
>>  Selection.MergeCells = True
>>  Range("A1").Select
>>
>>End Sub

で、前掲例題

┌─┬─┬───┐
│A │B │C   │
├─┼─┼───┤
│1 │あ│a   │
├─┼─┼───┤
│2 │い│   │
├─┼─┼───┤
│3 │う│b,c  │
├─┼─┼───┤
│4 │え│d   │
├─┼─┼───┤
│5 │お│e,f,g │
└─┴─┴───┘

を処理してみたのですが

ワークシートSheet1に変換された表は

┌─┬─┬─────────┐
│A │B │         │
├─┼─┼─────────┘
│1 │あ│
├─┼─┤
│1 │a │
├─┼─┤
│2 │い│
├─┼─┤
│3 │う│
├─┼─┤
│3 │b │
├─┼─┤
│3 │c │
├─┼─┤
│4 │え│
├─┼─┤
│4 │d │
├─┼─┤
│5 │お│
├─┼─┤
│5 │e │
├─┼─┤
│5 │f │
├─┼─┤
│5 │g │
└─┴─┘

のようになってしまい、私が望んでいた処理結果

┌─┬─┬───┐
│A │B │C   │
├─┼─┼───┤
│1 │あ│a   │
├─┼─┼───┤
│2 │い│   │
├─┼─┼───┤
│3 │う│b   │
├─┼─┼───┤
│3 │う│c   │
├─┼─┼───┤
│4 │え│d   │
├─┼─┼───┤
│5 │お│e   │
├─┼─┼───┤
│5 │お│f   │
├─┼─┼───┤
│5 │お│g   │
└─┴─┴───┘

のようにはなりませんでした。また変換処理表はワークシートSheet2に出力したいんです。たびたびですみませんが、いま一度この例題でVBAコードをチェックして頂けませんか?

【17673】Re:文字列のカンマ区切りとワークシート...
回答  かみちゃん  - 04/9/4(土) 19:37 -

引用なし
パスワード
   こんにちは。かみちゃん です。

>のようにはなりませんでした。すみませんが、一度この例題でVBAコードをチェックして頂けませんか?

私も勘違いしていましたので、勉強がてらKeinさんのコードを見ました。
下記のようにすると、うまく動くようです。

Sub MyData_Split()
  Dim i As Long, j As Long
  Dim Ary1() As String, Ary2() As String, Ary3() As String
  Dim SpAry As Variant, V As Variant
 
  With Sheets("Sheet1")
   For i = 1 To .Range("A1").End(xlDown).Row
     If IsEmpty(.Cells(i, 3).Value) Then
      ReDim Preserve Ary1(j): Ary1(j) = .Cells(i, 1).Value
      ReDim Preserve Ary2(j): Ary2(j) = ""
      ReDim Preserve Ary3(j): Ary3(j) = ""
      j = j + 1
     Else
      If Len(.Cells(i, 3).Value) = 1 Then
        ReDim Preserve Ary1(j): Ary1(j) = .Cells(i, 1).Value
        ReDim Preserve Ary2(j): Ary2(j) = .Cells(i, 2).Value
        ReDim Preserve Ary3(j): Ary3(j) = .Cells(i, 3).Value
        j = j + 1
      Else
        SpAry = Split(.Cells(i, 3).Value, ",")
        For Each V In SpAry
         ReDim Preserve Ary1(j): Ary1(j) = .Cells(i, 1).Value
         ReDim Preserve Ary2(j): Ary2(j) = .Cells(i, 2).Value
         ReDim Preserve Ary3(j): Ary3(j) = V
         j = j + 1
        Next
        Erase SpAry
      End If
     End If
   Next i
  End With
  With Sheets("Sheet2")
   .Cells(1, 1).Resize(UBound(Ary1) + 1).Value = _
   WorksheetFunction.Transpose(Ary1)
   .Cells(1, 2).Resize(UBound(Ary2) + 1).Value = _
   WorksheetFunction.Transpose(Ary2)
   .Cells(1, 3).Resize(UBound(Ary3) + 1).Value = _
   WorksheetFunction.Transpose(Ary3)
   .Cells(1, 1).CurrentRegion.Borders.LineStyle = 1
  End With
  Erase Ary1, Ary2, Ary3
End Sub

【17674】Re:文字列のカンマ区切りとワークシート...
質問  しん E-MAIL  - 04/9/4(土) 19:58 -

引用なし
パスワード
   ▼かみちゃん さん:

こんばんは、しんです。たびたびですみませんが

>さきほどのコードのうち、以下の★印の行を修正してください。
>
>   For ColumnNo = 3 To MaxColumn '★
>    If Cells(RowNo, ColumnNo).Value <> "" Then
>     If ColumnNo > 3 Then '★
>      Rows(RowNo).Copy
>      Rows(RowNo + 1).Insert Shift:=xlDown
>      RowNo = RowNo + 1
>      MaxRow = MaxRow + 1
>      Application.CutCopyMode = False
>      Cells(RowNo - 1, ColumnNo).Copy Destination:=Cells(RowNo, 3) '★
>     End If
>    Else
>     Exit For
>    End If
>   Next
>
というご助言し従って、VBAコードを書き改め処理してみたのですが、今度は

ワークシートSheet1に変換された表は

┌─┬─┬─────────┐
│A │B │         │
├─┼─┼─────────┘
│1 │あ│
├─┼─┤
│2 │い│
├─┼─┤
│3 │う│
├─┼─┤
│3 │う│
├─┼─┤
│3 │う│
├─┼─┤
│4 │え│
├─┼─┤
│5 │お│
├─┼─┤
│5 │お│
├─┼─┤
│5 │お│
└─┴─┘

のようになってしまい、やはり、私が望んでいた処理結果(さきほどのメール)のようにはなりませんでした。

>なお、さきほどのコードも含めてSheet1自身を展開するようにしています。
>Sheet2はあらかじめ用意してあるのでしょうか?

はい、Sheet2はあらかじめ用意してあり、これに変換結果を表記したいんですが・・・。それと行と列の数は任意であり、カンマ区切りのある文字列のあるセルはいつも最終列です。

>最初にSheet1をSheet2にコピーして開始する方法であれば、このコードが使えるのですが、はじめから用意してあるSheet2に展開したいのであれば、かなり手を加えないといけなくなります。

もし、Sheet2への出力がかみちゃんにとって大変な作業であれば、あまりご迷惑をおかけするのも申し訳けありませんので、Sheet1への出力でもかまいません。

【17675】Re:文字列のカンマ区切りとワークシート...
回答  かみちゃん  - 04/9/4(土) 20:29 -

引用なし
パスワード
   こんにちは。かみちゃん です。

>のようになってしまい、やはり、私が望んでいた処理結果(さきほどのメール)のようにはなりませんでした。

申し訳ありません。
もう一箇所修正しなければいけない箇所を言っていませんでした。
下記の★印の行も修正してください。

  '列方向へ挿入した列全体を削除
  Range(Columns(4), Columns(MaxColumn)).Delete Shift:=xlToLeft '★

>もし、Sheet2への出力がかみちゃんにとって大変な作業であれば、あまりご迷惑をおかけするのも申し訳けありませんので、Sheet1への出力でもかまいません。

改造に少しお時間をいただきたいと思いますが、
Sheet1への出力ではなく、Sheet2を新規に追加する仕組みではいけませんか?

【17676】Re:文字列のカンマ区切りとワークシート...
質問  しん E-MAIL  - 04/9/4(土) 20:36 -

引用なし
パスワード
   ▼かみちゃん さん:
こんにちは。しんです。

>私も勘違いしていましたので、勉強がてらKeinさんのコードを見ました。
>下記のようにすると、うまく動くようです。
>
>Sub MyData_Split()
>  Dim i As Long, j As Long
>  Dim Ary1() As String, Ary2() As String, Ary3() As String
>  Dim SpAry As Variant, V As Variant
> 
>  With Sheets("Sheet1")
>   For i = 1 To .Range("A1").End(xlDown).Row
>     If IsEmpty(.Cells(i, 3).Value) Then
>      ReDim Preserve Ary1(j): Ary1(j) = .Cells(i, 1).Value
>      ReDim Preserve Ary2(j): Ary2(j) = ""
>      ReDim Preserve Ary3(j): Ary3(j) = ""
>      j = j + 1
>     Else
>      If Len(.Cells(i, 3).Value) = 1 Then
>        ReDim Preserve Ary1(j): Ary1(j) = .Cells(i, 1).Value
>        ReDim Preserve Ary2(j): Ary2(j) = .Cells(i, 2).Value
>        ReDim Preserve Ary3(j): Ary3(j) = .Cells(i, 3).Value
>        j = j + 1
>      Else
>        SpAry = Split(.Cells(i, 3).Value, ",")
>        For Each V In SpAry
>         ReDim Preserve Ary1(j): Ary1(j) = .Cells(i, 1).Value
>         ReDim Preserve Ary2(j): Ary2(j) = .Cells(i, 2).Value
>         ReDim Preserve Ary3(j): Ary3(j) = V
>         j = j + 1
>        Next
>        Erase SpAry
>      End If
>     End If
>   Next i
>  End With
>  With Sheets("Sheet2")
>   .Cells(1, 1).Resize(UBound(Ary1) + 1).Value = _
>   WorksheetFunction.Transpose(Ary1)
>   .Cells(1, 2).Resize(UBound(Ary2) + 1).Value = _
>   WorksheetFunction.Transpose(Ary2)
>   .Cells(1, 3).Resize(UBound(Ary3) + 1).Value = _
>   WorksheetFunction.Transpose(Ary3)
>   .Cells(1, 1).CurrentRegion.Borders.LineStyle = 1
>  End With
>  Erase Ary1, Ary2, Ary3
>End Sub

ということでしたので、このVBAコードを使って私も例題を変換処理してみたところ

┌─┬─┬───┐
│A │B │C   │
├─┼─┼───┤
│1 │あ│a   │
├─┼─┼───┤
│2 │ │   │
├─┼─┼───┤
│3 │う│b   │
├─┼─┼───┤
│3 │う│c   │
├─┼─┼───┤
│4 │え│d   │
├─┼─┼───┤
│5 │お│e   │
├─┼─┼───┤
│5 │お│f   │
├─┼─┼───┤
│5 │お│g   │
└─┴─┴───┘

のような変換結果となり、まだバグがありそうです。見てご覧の通り、Sheet2のセルB3のデータが空セルとなっています。例題だとこのセルには「い」の文字列データが入っていなければなりませんが・・・。それとこのコードもやはり列の数には制約があるようで、最終列は3列目と固定されているようですね。
バグ取りと列の制約をはずすことが可能でしょうか?

【17677】Re:文字列のカンマ区切りとワークシート...
回答  かみちゃん  - 04/9/4(土) 20:55 -

引用なし
パスワード
   こんにちは。かみちゃん です。

>のような変換結果となり、まだバグがありそうです。見てご覧の通り、Sheet2のセルB3のデータが空セルとなっています。例題だとこのセルには「い」の文字列データが入っていなければなりませんが・・・。それとこのコードもやはり列の数には制約があるようで、最終列は3列目と固定されているようですね。
>バグ取りと列の制約をはずすことが可能でしょうか?

申し訳ありません。
以下の★印の行を修正してください。
とりあえず、最終列がC列だった場合としています。

   For i = 1 To .Range("A1").End(xlDown).Row
     If IsEmpty(.Cells(i, 3).Value) Then
      ReDim Preserve Ary1(j): Ary1(j) = .Cells(i, 1).Value
      ReDim Preserve Ary2(j): Ary2(j) = .Cells(i, 2).Value '★
      ReDim Preserve Ary3(j): Ary3(j) = ""
      j = j + 1

なお、「列の制約」ですが、「行と列の数は任意とします。要は最終列にあるカ
ンマ区切りのデータを分離」とあるのですが、最終列を取得して処理し、その左
2列を一緒に転記するよな仕組みでいいですか?
たとえば、最終列がJ列だったとすれば、J列をカンマ区切りの処理をする。
処理後、H列とI列とともに転記するような仕組みがお望みですか?
それと、最終列を取得するときに使いたいのですが、タイトル行は、1行目に必
ずあるものとするのでしょうか?または、これも任意なのでしょうか?
そもそも処理対象範囲どこからどこまでかをまず特定しなければ、処理ができないと思います。
また、転記先(Sheet2)の対象範囲も同じくです。

その、処理対象範囲についての考え方をもう少し提示してください。
私もKeinさんも、A1から始まる3列に対して処理をすることを考えています。

【17678】Re:文字列のカンマ区切りとワークシート...
回答  Kein  - 04/9/4(土) 21:23 -

引用なし
パスワード
   すいません、行数と列数は不明なのでしたね。これでやってみて下さい。
テストはうまくいきましたが。

Sub Data_Align()
  Dim VAry As Variant, SAry As Variant
  Dim i As Long, ER As Long
  Dim x As Long, y As Long
 
  With Sheets("Sheet1")
   With .Range("A1").CurrentRegion
     x = .Columns.Count: ER = .Rows.Count
   End With
   If .Columns(x).Find("*,*", , xlValues) Is Nothing Then
     MsgBox x & " 列にカンマ区切りのデータがありません", 48
     Exit Sub
   End If
   For i = 1 To ER
     If Len(.Cells(i, x).Value) < 2 Then
      VAry = .Cells(i, 1).Resize(, x).Value
      Sheets("Sheet2").Range("A65536").End(xlUp).Offset(1) _
      .Resize(, x).Value = VAry
     Else
      SAry = Split(.Cells(i, x).Value, ",")
      y = UBound(SAry) + 1
      VAry = .Cells(i, 1).Resize(, x - 1).Value
      With Sheets("Sheet2").Range("A65536").End(xlUp)
        .Offset(1).Resize(y, x - 1).Value = VAry
        .Offset(1, x - 1).Resize(y).Value = _
        WorksheetFunction.Transpose(SAry)
      End With
      Erase SAry
     End If
   Next i
  End With
End Sub

【17680】Re:文字列のカンマ区切りとワークシート...
回答  かみちゃん  - 04/9/4(土) 21:30 -

引用なし
パスワード
   こんにちは。かみちゃん です。

>>もし、Sheet2への出力がかみちゃんにとって大変な作業であれば、あまりご迷惑をおかけするのも申し訳けありませんので、Sheet1への出力でもかまいません。
>
>改造に少しお時間をいただきたいと思いますが、
>Sheet1への出力ではなく、Sheet2を新規に追加する仕組みではいけませんか?

とりあえず、Sheet1を作業用シートにコピー(シートのコピー)して、作業用シート上で変形処理をして、結果をSheet2へコピーしたのち、必要に応じて罫線処理させるようにしてみました。
これであれば、前回の応用ということになります。

なお、「行列が任意」については、A1を含む空白行、空白列で囲まれたセル範囲になっていますので、A1がその範囲に含まれているという制約だけになります。

Sub Macro1()
  Dim MaxRow As Long, MaxColumn As Integer, MaxColumnStart As Integer
  Dim RowNo As Long, ColumnNo As Integer
  
  '作業用シートにコピー '★
  Sheets("Sheet1").Copy After:=Sheets("Sheet1") '★
  '変形前の最終列を取得
  '表の途中に空白行、空白列がないことが前提
  MaxColumn = Range("A1").CurrentRegion.Columns.Count
  MaxColumnStart = MaxColumn
  '最終列をカンマ区切りで分割
  Columns(MaxColumn).Select
  Selection.TextToColumns Destination:=Cells(1, MaxColumn), DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
    Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
    :=Array(1, 1), TrailingMinusNumbers:=True
  '変形後の表の大きさを取得
  MaxColumn = Range("A1").CurrentRegion.Columns.Count
  MaxRow = Range("A1").CurrentRegion.Rows.Count
  '変形処理(列方向へ挿入したセルを行方向へ展開)
  RowNo = 2
  Do Until RowNo > MaxRow
   For ColumnNo = 3 To MaxColumn
    If Cells(RowNo, ColumnNo).Value <> "" Then
     If ColumnNo > 3 Then
      Rows(RowNo).Copy
      Rows(RowNo + 1).Insert Shift:=xlDown
      RowNo = RowNo + 1
      MaxRow = MaxRow + 1
      Application.CutCopyMode = False
      Cells(RowNo - 1, ColumnNo).Copy Destination:=Cells(RowNo, 3)
     End If
    Else
     Exit For
    End If
   Next
   RowNo = RowNo + 1
  Loop
  '列方向へ挿入した列全体を削除
  Range(Columns(4), Columns(MaxColumn)).Delete Shift:=xlToLeft
  '作業シートからSheet2へコピーする。コピーしたら作業シートを削除 '★
  Range("A1").CurrentRegion.Copy Destination:=Sheets("Sheet2").Range("A1") '★
  Application.DisplayAlerts = False '★
  ActiveSheet.Delete '★
  Application.DisplayAlerts = True '★
  Sheets("Sheet2").Select '★
  Range("A1").Select

  '罫線処理が必要であれば、ここから記述
  '変形後の表全体の罫線処理(マクロの記録により記述)
  Range("A1").CurrentRegion.Select
  '〜以下省略 以下のURLに掲載のコードを参照〜
  'http://www.vbalab.net/vbaqa/c-board.cgi?cmd=one;no=17548;id=excel
End Sub

【17681】Re:文字列のカンマ区切りとワークシート...
質問  しん E-MAIL  - 04/9/4(土) 21:57 -

引用なし
パスワード
   ▼かみちゃん さん:
こんにちは。しんです。
>
>   For i = 1 To .Range("A1").End(xlDown).Row
>     If IsEmpty(.Cells(i, 3).Value) Then
>      ReDim Preserve Ary1(j): Ary1(j) = .Cells(i, 1).Value
>      ReDim Preserve Ary2(j): Ary2(j) = .Cells(i, 2).Value '★
>      ReDim Preserve Ary3(j): Ary3(j) = ""
>      j = j + 1
>
のようにコードを修正したら例題はうまく処理できました。また、かみちゃん提案のVBAコードもさきほどのメールのように修正しましたら、これも正常に処理できました。どうもありがとうございます。

>なお、「列の制約」ですが、「行と列の数は任意とします。要は最終列にあるカ
>ンマ区切りのデータを分離」とあるのですが、最終列を取得して処理し、その左
側全列を一緒に転記するよな仕組みにして下さい。

>たとえば、最終列がJ列だったとすれば、J列をカンマ区切りの処理をする。
>処理後、
A列、B列、C列、D列、E列、F列、H列とI列とともに転記するような仕組みを望んでいます。

>それと、最終列を取得するときに使いたいのですが、タイトル行は、1行目に必
>ずあるものと
します。

また場合によっては2行目に副タイトル行があり、その場合はSheet2には副タイトル行は表示しないようにしたいんです(これはオプションで、副タイトル行あり(
option=1)、なし(option=2)の判断をあらかじめオプションとして選ぶ)。すなわち、「副タイトル行あり」のオプションを選択した場合は、Sheet1の表のカンマ区切り変換処理は3行目から行うことになり、そうでない場合は2行目からの処理とします。ただし、出力結果を表示するタイトル行はSheet1の1行目をSheet2の1行目に転記し、Sheet2の2行目以降はSheet1でカンマ区切り文字列データを処理した行全体が出力されるようにします。

Sheet1とSheet2は同じブックでもよく、またSheet1しかないブックに新たにSheet2を挿入し、そこへ変換結果を出力するという風にしたいんです。要はSheet1の上に変換結果を上書きしないように別のワークシートに変換結果を出力したいだけです。(ですからの別のブックのSheet1に変換結果を表示するのでもいいです。)

>私もKeinさんも、A1から始まる3列に対して処理をすることを考えて
いらっしゃるようですが、A1から始まる任意の列に対して処理をして欲しいのです(ただし、カンマ区切りのある文字列データは必ず最終列にあるものとします。

以上、よろしくお願いします。

オプション2が少しややこしいかも知れませんので例題を挙げておきます。

オプション2を選んだ場合(option=2):

Sheet1(変換前)
┌─┬─┬─┬───┐
│A │B │C │D   │←タイトル行
├─┼─┼─┼───┤
│A'│B'│C'│D'  │←副タイトル行
├─┼─┼─┼───┤
│1 │あ│ │a   │
├─┼─┼─┼───┤
│2 │い│甲│   │
├─┼─┼─┼───┤
│3 │う│乙│b,c  │
├─┼─┼─┼───┤
│4 │え│丙│d   │
├─┼─┼─┼───┤
│5 │お│ │e,f,g │
└─┴─┴─┴───┘

Sheet2(変換後)
┌─┬─┬─┬───┐
│A │B │C │D   │←タイトル行
├─┼─┼─┼───┤
│1 │あ│ │a   │
├─┼─┼─┼───┤
│2 │い│甲│   │
├─┼─┼─┼───┤
│3 │う│乙│b   │
├─┼─┼─┼───┤
│3 │う│乙│c   │
├─┼─┼─┼───┤
│4 │え│丙│d   │
├─┼─┼─┼───┤
│5 │お│ │e   │
├─┼─┼─┼───┤
│5 │お│ │f   │
├─┼─┼─┼───┤
│5 │お│ │g   │
└─┴─┴─┴───┘

のうようにしたいんですが、どうかよろしくお願いします。

【17682】Re:文字列のカンマ区切りとワークシート...
発言  かみちゃん  - 04/9/4(土) 22:18 -

引用なし
パスワード
   こんにちは。かみちゃん です。

>>なお、「列の制約」ですが、「行と列の数は任意とします。要は最終列にあるカ
>>ンマ区切りのデータを分離」とあるのですが、最終列を取得して処理し、その左
>側全列を一緒に転記するよな仕組みにして下さい。

はい。私のコードも、KeinさんのコードData_AlignマクロもA1を含む空白行空白列で囲まれた範囲を処理しようとしていますので、これは対応できていると思います。

>また場合によっては2行目に副タイトル行があり、その場合はSheet2には副タイトル行は表示しないようにしたいんです(これはオプションで、副タイトル行あり(
>option=1)、なし(option=2)の判断をあらかじめオプションとして選ぶ)。

これは、新しい仕様ですね。

>Sheet1とSheet2は同じブックでもよく、またSheet1しかないブックに新たにSheet2を挿入し、そこへ変換結果を出力するという風にしたいんです。要はSheet1の上に変換結果を上書きしないように別のワークシートに変換結果を出力したいだけです。(ですからの別のブックのSheet1に変換結果を表示するのでもいいです。)

私のコードを最終的に、Sheet1とSheet2を用意して、Sheet1をコピー(シートのコピー)して変形処理をして、その結果をSheet2にコピーし、Sheet2にコピーしたあと、Sheet1からコピーしたシートを削除するようにしています。
しかし、Sheet1をコピーして、変形処理をして、そのシートをそのまま使えばいいのでは?と思っていますが、いかがですか?

>>私もKeinさんも、A1から始まる3列に対して処理をすることを考えて
>いらっしゃるようですが、A1から始まる任意の列に対して処理をして欲しいのです(ただし、カンマ区切りのある文字列データは必ず最終列にあるものとします。

これは、対応できています。

>オプション2が少しややこしいかも知れませんので例題を挙げておきます。

これは、オプションが選択されていると副タイトルは非表示ですか?
それとも、行そのものを出力しないのですか?

あと、副タイトル行の件以外で、詰まっているところはありますでしょうか?

【17683】Re:文字列のカンマ区切りとワークシート...
回答  かみちゃん  - 04/9/4(土) 22:41 -

引用なし
パスワード
   こんにちは。かみちゃん です。

>>オプション2が少しややこしいかも知れませんので例題を挙げておきます。
>
>これは、オプションが選択されていると副タイトルは非表示ですか?
>それとも、行そのものを出力しないのですか?

とりあえず私のコードでの対処方法です。
  '列方向へ挿入した列全体を削除
  Range(Columns(4), Columns(MaxColumn)).Delete Shift:=xlToLeft
  If 副タイトル行ありの場合 Then
   '副タイトルを削除
   Rows(2).Delete Shift:=xlUp
   '副タイトルを非表示
   'Rows(2).EntireRow.Hidden = True
  End If
とすると対応できると思います。

【17684】Re:文字列のカンマ区切りとワークシート...
回答  Kein  - 04/9/4(土) 22:50 -

引用なし
パスワード
   えっと、通常は1行目のみにタイトルがあり、オプションで副タイトルが有る場合は、
そこも除外する。ということですね ? それなら・・

Sub Data_Align()
  Dim Sh As Worksheet
  Dim VAry As Variant, SAry As Variant
  Dim i As Long, SR As Long, ER As Long
  Dim Ans As Long, x As Long, y As Long
 
  On Error Resume Next
  Set Sh = Worksheets("Sheet2")
  If Err.Number > 0 Then
   Set Sh = Worksheets.Add(After:=Sheets("Sheet1"))
   AtiveSheet.Name = "Sheet2": Err.Clear
  End If
  On Error GoTo 0
  Ans = MsgBox("2行目を副タイトル行としますか", 36)
  If Ans = 6 Then
   SR = 3
  Else
   SR = 2
  End If
  With Sheets("Sheet1")
   With .Range("A1").CurrentRegion
     x = .Columns.Count: ER = .Rows.Count
   End With
   If .Columns(x).Find("*,*", , xlValues) Is Nothing Then
     MsgBox x & " 列にカンマ区切りのデータがありません", 48
     Exit Sub
   End If
   For i = SR To ER
     If Len(.Cells(i, x).Value) < 2 Then
      VAry = .Cells(i, 1).Resize(, x).Value
      Sh.Range("A65536").End(xlUp).Offset(1) _
      .Resize(, x).Value = VAry
     Else
      SAry = Split(.Cells(i, x).Value, ",")
      y = UBound(SAry) + 1
      VAry = .Cells(i, 1).Resize(, x - 1).Value
      With Sh.Range("A65536").End(xlUp)
        .Offset(1).Resize(y, x - 1).Value = VAry
        .Offset(1, x - 1).Resize(y).Value = _
        WorksheetFunction.Transpose(SAry)
      End With
      Erase SAry
     End If
   Next i
  End With
  Sh.Rows(1).Delete xlShiftUp: Sh.Activate
  Set Sh = Nothing
End Sub

で、どうでしょーか ?

【17685】Re:文字列のカンマ区切りとワークシート...
回答  Kein  - 04/9/4(土) 22:56 -

引用なし
パスワード
   あー・・1行目のタイトルだけは、必ず転記するわけでしたか。
それなら

Sub Data_Align()
  Dim Sh As Worksheet
  Dim VAry As Variant, SAry As Variant
  Dim i As Long, SR As Long, ER As Long
  Dim Ans As Long, x As Long, y As Long
 
  On Error Resume Next
  Set Sh = Worksheets("Sheet2")
  If Err.Number > 0 Then
   Set Sh = Worksheets.Add(After:=Sheets("Sheet1"))
   AtiveSheet.Name = "Sheet2": Err.Clear
  End If
  On Error GoTo 0
  Ans = MsgBox("2行目を副タイトル行としますか", 36)
  If Ans = 6 Then
   SR = 3
  Else
   SR = 2
  End If
  With Sheets("Sheet1")
   With .Range("A1").CurrentRegion
     x = .Columns.Count: ER = .Rows.Count
   End With
   If .Columns(x).Find("*,*", , xlValues) Is Nothing Then
     MsgBox x & " 列にカンマ区切りのデータがありません", 48
     Exit Sub
   End If
   For i = SR To ER
     If Len(.Cells(i, x).Value) < 2 Then
      VAry = .Cells(i, 1).Resize(, x).Value
      Sh.Range("A65536").End(xlUp).Offset(1) _
      .Resize(, x).Value = VAry
     Else
      SAry = Split(.Cells(i, x).Value, ",")
      y = UBound(SAry) + 1
      VAry = .Cells(i, 1).Resize(, x - 1).Value
      With Sh.Range("A65536").End(xlUp)
        .Offset(1).Resize(y, x - 1).Value = VAry
        .Offset(1, x - 1).Resize(y).Value = _
        WorksheetFunction.Transpose(SAry)
      End With
      Erase SAry
     End If
   Next i
   Sh.Range("A1")Resize(, x).Value = _
   .Range("A1").Resize(, x).Value
  End With
  Sh.Activate: Set Sh = Nothing
End Sub

【17686】Re:文字列のカンマ区切りとワークシート...
発言  Kein  - 04/9/4(土) 23:00 -

引用なし
パスワード
   もうちょっと改造します。念のため Sheet2 が存在してたとき、全セルをクリアして
おきます。

>If Err.Number > 0 Then
>  Set Sh = Worksheets.Add(After:=Sheets("Sheet1"))
>  AtiveSheet.Name = "Sheet2": Err.Clear
>End If


If Err.Number > 0 Then
 Set Sh = Worksheets.Add(After:=Sheets("Sheet1"))
  AtiveSheet.Name = "Sheet2": Err.Clear
Else
  Sh.Cells.ClearContents
End If

と、変更して下さい。

【17687】Re:文字列のカンマ区切りとワークシート...
発言  かみちゃん  - 04/9/4(土) 23:08 -

引用なし
パスワード
   こんにちは。かみちゃん です。

>あー・・1行目のタイトルだけは、必ず転記するわけでしたか。

さきほど提示されていたコードを勉強のために試してみましたら、
転記後のタイトルが2行目に転記されていたので、なぜかな?と悩んでいました。

で、今回提示されたコードを試してみたら、OKです。
仕組みがよくわからないので、勉強しないといけませんが・・・

ちなみに、コードの脱字があるので、修正しておきます。
細かいところで、すみません。

>  If Err.Number > 0 Then
>   Set Sh = Worksheets.Add(After:=Sheets("Sheet1"))
>   AtiveSheet.Name = "Sheet2": Err.Clear
>  End If

If Err.Number > 0 Then
 Set Sh = Worksheets.Add(After:=Sheets("Sheet1"))
 ActiveSheet.Name = "Sheet2": Err.Clear
' ^^^
Else
  Sh.Cells.ClearContents
End If

>   Sh.Range("A1")Resize(, x).Value = _
>   .Range("A1").Resize(, x).Value

   Sh.Range("A1").Resize(, x).Value = _
   .Range("A1").Resize(, x).Value
   'Range("A1").Resize の . がない

【17688】Re:文字列のカンマ区切りとワークシート...
発言  Kein  - 04/9/4(土) 23:42 -

引用なし
パスワード
   >コードの脱字があるので、修正しておきます
あぁ、どうもありがとうございます。しんさん、私のコードをテストするときは
レスしていただいた個所を修正して下さい。
>仕組みがよくわからないので
簡単に説明しておきますと、カンマのある列のセルを見ていって、1文字以下(空白を
含む)の場合ならA列からその列までのデータを、そのまま転記します。
2文字以上あるならカンマが含まれるとして、Split関数で配列にします。
配列要素の上限 + 1 が、その行のA列からカンマの列の一つ手前までの列データを
入力する行数になります。なので Resizeプロパティにて行数・列数を指定して
一気に代入し、最後にカンマのある列に、配列を行列変換して代入しているわけです。
その他のコードについては、かみちゃんさんの力量ならご理解いただけると思います。

【17690】Re:文字列のカンマ区切りとワークシート...
回答  Kein  - 04/9/4(土) 23:48 -

引用なし
パスワード
   ちょっと修正するところが多いので、書き直しておきますね。

Sub Data_Align()
  Dim Sh As Worksheet
  Dim VAry As Variant, SAry As Variant
  Dim i As Long, SR As Long, ER As Long
  Dim Ans As Long, x As Long, y As Long
 
  On Error Resume Next
  Set Sh = Worksheets("Sheet2")
  If Err.Number > 0 Then
   Set Sh = Worksheets.Add(After:=Sheets("Sheet1"))
   ActiveSheet.Name = "Sheet2": Err.Clear
  Else
   Sh.Cells.ClearContents
  End If
  On Error GoTo 0
  Ans = MsgBox("2行目を副タイトル行としますか", 36)
  If Ans = 6 Then
   SR = 3
  Else
   SR = 2
  End If
  With Sheets("Sheet1")
   With .Range("A1").CurrentRegion
     x = .Columns.Count: ER = .Rows.Count
   End With
   If .Columns(x).Find("*,*", , xlValues) Is Nothing Then
     MsgBox x & " 列にカンマ区切りのデータがありません", 48
     Exit Sub
   End If
   For i = SR To ER
     If Len(.Cells(i, x).Value) < 2 Then
      VAry = .Cells(i, 1).Resize(, x).Value
      Sh.Range("A65536").End(xlUp).Offset(1) _
      .Resize(, x).Value = VAry
     Else
      SAry = Split(.Cells(i, x).Value, ",")
      y = UBound(SAry) + 1
      VAry = .Cells(i, 1).Resize(, x - 1).Value
      With Sh.Range("A65536").End(xlUp)
        .Offset(1).Resize(y, x - 1).Value = VAry
        .Offset(1, x - 1).Resize(y).Value = _
        WorksheetFunction.Transpose(SAry)
      End With
      Erase SAry
     End If
   Next i
   Sh.Range("A1").Resize(, x).Value = _
   .Range("A1").Resize(, x).Value
  End With
  Sh.Activate: Set Sh = Nothing
End Sub

【17691】Re:文字列のカンマ区切りとワークシート...
お礼  しん E-MAIL  - 04/9/4(土) 23:59 -

引用なし
パスワード
   ▼Kein さん:
こんばんは、しんです。
Keinさん修正コード
>
>Sub Data_Align()
>  Dim Sh As Worksheet
>  Dim VAry As Variant, SAry As Variant
>  Dim i As Long, SR As Long, ER As Long
>  Dim Ans As Long, x As Long, y As Long
> 
>  On Error Resume Next
>  Set Sh = Worksheets("Sheet2")
>  If Err.Number > 0 Then
>   Set Sh = Worksheets.Add(After:=Sheets("Sheet1"))
>   ActiveSheet.Name = "Sheet2": Err.Clear
>  Else
>   Sh.Cells.ClearContents
>  End If
>  On Error GoTo 0
>  Ans = MsgBox("2行目を副タイトル行としますか", 36)
>  If Ans = 6 Then
>   SR = 3
>  Else
>   SR = 2
>  End If
>  With Sheets("Sheet1")
>   With .Range("A1").CurrentRegion
>     x = .Columns.Count: ER = .Rows.Count
>   End With
>   If .Columns(x).Find("*,*", , xlValues) Is Nothing Then
>     MsgBox x & " 列にカンマ区切りのデータがありません", 48
>     Exit Sub
>   End If
>   For i = SR To ER
>     If Len(.Cells(i, x).Value) < 2 Then
>      VAry = .Cells(i, 1).Resize(, x).Value
>      Sh.Range("A65536").End(xlUp).Offset(1) _
>      .Resize(, x).Value = VAry
>     Else
>      SAry = Split(.Cells(i, x).Value, ",")
>      y = UBound(SAry) + 1
>      VAry = .Cells(i, 1).Resize(, x - 1).Value
>      With Sh.Range("A65536").End(xlUp)
>        .Offset(1).Resize(y, x - 1).Value = VAry
>        .Offset(1, x - 1).Resize(y).Value = _
>        WorksheetFunction.Transpose(SAry)
>      End With
>      Erase SAry
>     End If
>   Next i
>   Sh.Range("A1").Resize(, x).Value = _
>   .Range("A1").Resize(, x).Value
>  End With
>  Sh.Activate: Set Sh = Nothing
>End Sub

で副タイトル行のある4列の例題を作って変換処理テストを行った結果、正常に変換できることが確認できました。
行列処理を行って一気に変換という素晴らしい技に感激しました。胸につかえていた処理が一気にできるようになり、ほんとうにどうもありがとうございました。

【17692】Re:文字列のカンマ区切りとワークシート...
お礼  しん E-MAIL  - 04/9/5(日) 0:04 -

引用なし
パスワード
   ▼かみちゃん さん:
こんばんは、しんです。

かみちゃんご呈示のVBAコード
>
>Sub Macro1()
>  Dim MaxRow As Long, MaxColumn As Integer, MaxColumnStart As Integer
>  Dim RowNo As Long, ColumnNo As Integer
>  
>  '作業用シートにコピー '★
>  Sheets("Sheet1").Copy After:=Sheets("Sheet1") '★
>  '変形前の最終列を取得
>  '表の途中に空白行、空白列がないことが前提
>  MaxColumn = Range("A1").CurrentRegion.Columns.Count
>  MaxColumnStart = MaxColumn
>  '最終列をカンマ区切りで分割
>  Columns(MaxColumn).Select
>  Selection.TextToColumns Destination:=Cells(1, MaxColumn), DataType:=xlDelimited, _
>    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
>    Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
>    :=Array(1, 1), TrailingMinusNumbers:=True
>  '変形後の表の大きさを取得
>  MaxColumn = Range("A1").CurrentRegion.Columns.Count
>  MaxRow = Range("A1").CurrentRegion.Rows.Count
>  '変形処理(列方向へ挿入したセルを行方向へ展開)
>  RowNo = 2
>  Do Until RowNo > MaxRow
>   For ColumnNo = 3 To MaxColumn
>    If Cells(RowNo, ColumnNo).Value <> "" Then
>     If ColumnNo > 3 Then
>      Rows(RowNo).Copy
>      Rows(RowNo + 1).Insert Shift:=xlDown
>      RowNo = RowNo + 1
>      MaxRow = MaxRow + 1
>      Application.CutCopyMode = False
>      Cells(RowNo - 1, ColumnNo).Copy Destination:=Cells(RowNo, 3)
>     End If
>    Else
>     Exit For
>    End If
>   Next
>   RowNo = RowNo + 1
>  Loop
>  '列方向へ挿入した列全体を削除
>  Range(Columns(4), Columns(MaxColumn)).Delete Shift:=xlToLeft
>  '作業シートからSheet2へコピーする。コピーしたら作業シートを削除 '★
>  Range("A1").CurrentRegion.Copy Destination:=Sheets("Sheet2").Range("A1") '★
>  Application.DisplayAlerts = False '★
>  ActiveSheet.Delete '★
>  Application.DisplayAlerts = True '★
>  Sheets("Sheet2").Select '★
>  Range("A1").Select
>
>  '罫線処理が必要であれば、ここから記述
>  '変形後の表全体の罫線処理(マクロの記録により記述)
>  Range("A1").CurrentRegion.Select
>  '〜以下省略 以下のURLに掲載のコードを参照〜
>  'http://www.vbalab.net/vbaqa/c-board.cgi?cmd=one;no=17548;id=excel
>End Sub

で例題の処理を行った結果、3列の場合は正常に変換できることが確認できました。かみちゃんとKeinさんには親身になってお世話を頂き、どうもほんとうにありがとうございました。今後ともよろしくご教示お願いします。

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