セル内の長文テキストの分割

質問

セル内の長文テキストを、任意の位置で分割し、下のセルへ移動させる方法を教えてください。

下図のように、エクセルのＡ列に長文のテキストが入力されているとします。
（|○○....｜は１つのセルのつもりです。）

| |　　　　　　　　　　　　　Ａ　　　　　　　　　　　|
|1|関東地方は雨模様が続きますが、東北地方は..........|
|2|今日のニュースは、新潟県で起こった事件の続報......|
|3|いつもお世話になっております。このところ..........｜
|4|The method is descrived in the blow figure .......｜
.....

これを、たとえば、
A2セルの「新潟県で」以降の文章をA3へ移動させ、
以降のセルの内容も一つ下のセルに移動させる方法はありますでしょうか？

| |　　　　　　　　　　　　　Ａ　　　　　　　　　　　|
|1|関東地方は雨模様が続きますが、東北地方は..........|
|2|今日のニュースは、新潟県で........................|
|3|起こった事件の続報................................|
|4|いつもお世話になっております。このところ..........｜
|5|The method is descrived in the blow figure .......｜

セル内のテキストの内容に規則性はありません。
文章を読みながら、任意の箇所で文章を区切っていく作業を行いたいのです。
マクロの記録をやってみましたがうまくいきませんでした。

どうぞよろしくお願いいたします。

回答No.7

_Kyle · ベストアンサー

様子を見ながら仕様を詰めていたのですが、
既に一段落ついちゃった感じですね。
今更感もありますが、一応ご参考まで。

イベントドリブンマクロなので、標準モジュールではなく
対象シートのシートモジュールに記述してください。

●動作の概要
　対象範囲のセルについて、
　区切とする部分に　【Alt+Enterでセル内改行を入れて確定】　すると、
　改行数に応じて　【自動的にセルまたは行を挿入】　し、
　元の文字列を　【改行部分で分割して各セルにセット】　します。

　モード１　：　セルを挿入（他列に影響を与えない）
　モード２　：　空白行を挿入
　モード３　：　元の行をコピーして挿入

　とりあえず、下記では
　・対象範囲：A1:A65536
　・モード：1
　にしてありますが、ニーズに合わせて適当に変更してください。

'==================↓　ココカラ　↓==================
Private Sub Worksheet_Change(ByVal Target As Range)
　Dim myRng As Range
　Dim myAry As Variant
　Dim myOpt As Long
　Dim i　　 As Long

　myOpt = 1　'挿入モード
　Set myRng = Range("A1:A65536")　'対象範囲

　Set myRng = Intersect(myRng, Target)
　If myRng Is Nothing Then Exit Sub
　If InStr(1, myRng.Text, vbLf) = 0 Then Exit Sub
　Set myRng = myRng(1, 1)
　myAry = Split(myRng.Value, vbLf)
　Application.EnableEvents = False
　Application.ScreenUpdating = False
　With myRng
　　.Value = myAry(0)
　　For i = 1 To UBound(myAry)
　　　Select Case myOpt
　　　　Case 1
　　　　　.Offset(i, 0).Insert xlShiftDown
　　　　Case 2
　　　　　.Offset(i, 0).EntireRow.Insert xlShiftDown
　　　　Case 3
　　　　　.EntireRow.Copy
　　　　　.Offset(i, 0).EntireRow.Insert xlShiftDown
　　　　　Application.CutCopyMode = False
　　　End Select
　　　.Offset(i, 0).Value = myAry(i)
　　Next i
　　.Offset(i, 0).Activate
　End With
　Application.ScreenUpdating = True
　Application.EnableEvents = True
End Sub
'==================↑　ココマデ　↑==================

Excel2003,2007で動作確認。ご参考まで。

お礼

出来ました！
す、すばらしい...。
動画までつけていただいて本当にありがとうございます。
カスタマイズできるなんて、さらに素敵です。
この作業を大量に行う必要があったので、本当に助かります！
うれしいです！
なんとお礼を申し上げていいやら。
ありがとうございました。m..m

回答No.6

Sinogi

>できたら、オリジナルデータは消去したいのですが、どうしたらいいでしょうか？

やっぱり・・・そんな気はしてました（＾＾；；

とりあえず簡単なのは
WR = WR + StrNum(RepStr - 1)
を
WR = WR + StrNum(RepStr - 1) - 1
とすればオリジナルは一番下に押しやられます。

それと＃４で述べわすれていましたがこのマクロは対照データが（A1）から始まる連続データになっていることが前提です。
途中で空白行があればその直前で停止しますのでご注意を。
開始セルを指定したい場合は
NumStr = Cells(1, 1).End(xlDown).Row
を修正してください。

＃どう修正するかはご自分で調査してください

このへんでご勘弁を（＾＾々

お礼

たびたびの質問にご回答いただきありがとうございました。
ご回答を参考に学びたいと思います。
本当にありがとうございました。

回答No.5

alna_sag

(1)分割したいセルに、セルカーソルを移動
(2)F2でセルの文字列を選択できるようにする。
(3)分割する位置に、文字カーソルを移動して文字列をCtrl+Xで切取る
(4)Enterを押してセルの中から抜ける（下のセルに移動する）
(5)そのままの位置で右クリックして［挿入］を選択
(6)［下方向にシフト］を選択してからのセルを挿入する
(7)F2でセルの文字列を選択できるようにする。
(8)Ctrl+Vで貼付け

こんなやり方でもいいんでしょうか？

お礼

数回の作業でしたら、ご回答いただいた
方法でも問題ないのですが、
同じ作業を何度も繰り返す必要があったため、
いい方法がないかしらとお尋ねしました。
ご丁寧なご回答ありがとうございました。

回答No.4

Sinogi

となりのセルにデータがあるとのことなので、A列でオリジナルセルの直下に分割された文言を挿入するマクロをつくってみました。
区切り記号は　＾　を使用します。
＾　は手作業で希望の位置に入れてください。
文頭/文末には＾は無いものと考えています。

＾の入ったオリジナルデータは残るようにしています。

ご参考に

Option Explicit
Sub Strdiv()
Dim StrW()
Dim StrNum()
Dim RepStr, RepWord, StRow, WorkCount, NumStr, WorkLen, WordMax, WorkStr, SpltNum, WR

NumStr = Cells(1, 1).End(xlDown).Row
ReDim StrNum(NumStr) '区切り数
StrNum(0) = 0
For RepStr = 1 To NumStr
WorkStr = Cells(RepStr, 1).Value
WorkLen = Len(WorkStr)
StrNum(RepStr) = 1
SpltNum = 1 '区切りの最初
For RepWord = 1 To WorkLen
If Mid(WorkStr, RepWord, 1) = "^" Then ' ^があれば区切記号
StrNum(RepStr) = StrNum(RepStr) + 1
If StrNum(RepStr) > WordMax Then
WordMax = StrNum(RepStr) '区切り数の最大値
ReDim Preserve StrW(NumStr, WordMax)
End If
StrW(RepStr, StrNum(RepStr) - 1) = Mid(WorkStr, SpltNum, RepWord - SpltNum)
SpltNum = RepWord + 1
End If
Next RepWord
StrW(RepStr, StrNum(RepStr)) = Mid(WorkStr, SpltNum, RepWord - SpltNum)
Next RepStr
WR = 0
For RepStr = 1 To NumStr
WR = WR + StrNum(RepStr - 1)
For RepWord = 1 To StrNum(RepStr)
Cells(RepStr + WR + RepWord, 1).Insert shift:=xlDown
Cells(RepStr + WR + RepWord, 1).Value = StrW(RepStr, RepWord)
Next RepWord
Next RepStr
End Sub

補足

ありがとうございます！
これがしたかったんです！
すばらしいです。
ほんとにありがとうございます。

>＾の入ったオリジナルデータは残るようにしています。
できたら、オリジナルデータは消去したいのですが、どうしたらいいでしょうか？
教えていただけると大変ありがたいです。
よろしくお願いいたします。

回答No.3

Sinogi

文章中に絶対出現しない記号があれば、その記号を希望の位置に入力して、
区切位置→ウィザードでその文字を指定
すればセルで列方向に分割されます。

下のセルへの移動は・・・・がんばればマクロ化できると思います
１行ずつ分割されたセル数をカウントし、行挿入をループかな?

お礼

列方向へ分割はできるのですね。
ありがとうございます。
ちゃれんじしてみます！
ありがとうございました。

回答No.2

noname#99913

どこで区切るのかが決まっていなければ、関数だろうがマクロを使おうが、不可能です。

No.1の方のやり方が最良だと思いますが、それが嫌なら手作業でやるしかないでしょう。

ところで、どうしても別セルにしなければいけないのですか？　セル内改行でよければ、
(1)分割したいセルに、セルカーソルを移動
(2)F2を押す。
(3)分割する位置に、文字カーソルを移動
(4)Alt＋Enterを押す。
で改行できます。

お礼

ありがとうございました！

補足

ご回答ありがとうございます。
どこで区切るかが問題なのですね。
ではAlt＋Enterを先に区切りたい箇所に入れて、
それを目印に、同様のことを自動化するのは可能なのでしょうか？

がんばって探してみます。
ありがとうございました！

回答No.1

goo39

(1)テキスト形式で保存（*.txt）
(2)テキストファイルを編集（必要な箇所で改行）して保存
(3)保存したテキストファイルをエクセルで開く

お礼

早速ありがとうございます。
できればエクセル上で確認しながら、
上記作業を行いたいと考えております。
（隣のセルに別のデータが入っているため）
どうもありがとうございました。