人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

Excelで2つの列を1つの列に合わせたい

今、I列とJ列にデータが入っております。J列のデータにおきまして、完全一致で“りんご”というキーワードに該当するセルがありましたら。
そのセルを、左のI列に移動させたいです。

I列には既にデータが入っているので、I列自体には関数などを入れることができず…困っております。

ちなみにJ列にある“りんご”というデータですが、左隣のI列は必ず空白セルになっているので、I列のデータが書き換わることはないです。

I列のデータを保持しつつ、J列のデータをI列に持っていけたらと思います。
よろしくお願い致します。

●質問者: moon-fondu
●カテゴリ:コンピュータ 学習・教育
○ 状態 :終了
└ 回答数 : 4/4件

▽最新の回答へ

1 ● Asayuri
●300ポイント


関数の式をエクセルファイルで作成しましたので、

次のURLからダウンロードしてください。

http://firestorage.jp/download/83c2c76af1d2c84fb7b3efdf10615849e6b35688

H列をコピーしてI列に値貼り付けすればご希望のデータが出来上がります。

よろしくお願いします。


moon-fonduさんのコメント
すごいです、うまくできました!ありがとうございます(^^;

Asayuriさんのコメント
うまくできて とてもうれしいです。 これからも エクセル質問してくださいね。

moon-fonduさんのコメント
遅くなりましてすみません、ありがとうございました!

2 ● a-kuma3
●900ポイント ベストアンサー

下記のマクロを標準モジュールにはりつけて、copy_cell サブルーチンを実行してください。

Function is_blank_cell(c)
 is_blank_cell = IsEmpty(c) Or c.Value = ""
End Function

Sub copy_cell()
 word = "りんご"
 dest_col = 9  ' I列
 src_col = 10  ' J列
 last_row = Cells(Rows.Count, src_col).End(xlUp).Row
 For r = 2 To last_row
 If Cells(r, src_col).Value = word And is_blank_cell(Cells(r, dest_col)) Then
 Cells(r, dest_col).Value = Cells(r, src_col).Value
 End If
 DoEvents
 Next
End Sub

何となく、2行目から始めてみました。
J列が複写対象になった場合には、その隣の I列のセルは必ず空白だということですが、いちおう空白かどうかの確認もしています。


因みに、「複写」じゃなくて「移動」にこだわりますか?


Z1000Sさんのコメント
オートフィルタで「りんご」だけ抽出してから、表示されている行を取得して、切り取り、隣のセルに貼り付けでできませんか? その方が、無駄なループが減って速いと思います

moon-fonduさんのコメント
いえ、移動で大丈夫です!スピードも、30秒もかからずに全部I列に合流できたので、大丈夫です(^^)/

a-kuma3さんのコメント
>id:Z1000S 一回だけしか使わないマクロだと思われるので、速度よりも素直さを優先。 フィルタで絞った後に貼り付けだと、 - 切り取りの場合には、切り取り元の非表示行まで移動されちゃう - コピーの場合には、貼り付けが非表示行にも貼り付けられる ので、単純にはいかないはず。 そういう意味でも、速度よりも素直さを優先した方がベター。

Z1000Sさんのコメント
To a-kuma3さん 言いたいことはわかりますが、私の言いたかったことが正しく伝わっていないのが残念です。 私の書き方が不十分だったのかもしれませんが フィルターをかけた後、一括で貼り付け処理するつもりは元々ありませんでした。ご指摘のような状況が発生することがわかっていましたので。 絞り込まれたデータのみ、最低限のループで処理させればよいと思っていました。 とりあえず、私の意図した物を載せました。 悪意等あってコメントしたわけではありません。 こういった方法もあるという提案くらいの軽いつもりでコメントしました。 考え方の違いもあるようですので、お気に触るようでしたらご容赦下さい。

a-kuma3さんのコメント
>> 悪意等あってコメントしたわけではありません。 << ぼくの書き方が悪かったかな。 回答歴を見てて、そんな方ではないことは分かってコメントしてました。 全然、気に障ったとかないですよ <tt>:-)</tt>

moon-fonduさんのコメント
遅くなりましてすみません、ありがとうございました。お二人のレビューは内容が深いですね、勉強になります(^^;

3 ● たか
●10ポイント

1)フィルタでI列の空白だけを抽出
2)空白セルに関数を入れる
3)フィルタで抽出された空白セル全てにコピペ

おまけ)関数のままで問題ならばそこで値の貼り付けでコピペ


フィルタで隠れている部分はコピペの対象外なので、元のI列データは維持したまま出来るかと。


moon-fonduさんのコメント
空白セルの抽出はやったことがないものでして…。Asayuriさんのファイルに入っていた関数や、a-kuma3さんのマクロで、うまく変更できました(^^;

4 ● Z1000S
●100ポイント

私の思うところが伝わっていなかったようなので。

「sTarget」に処理対象文字列(今回の例であれば「りんご」)を指定して実行して下さい。

Public Sub transferJ2I(ByVal sTarget As String)

Const TARGET_SHEET_NAME As String = "Sheet1"

'移動元列(J)
Const SOURCE_COL As Long = 10

'移動先列(I)
Const DEST_COL As Long = 9

Dim lHeaderRow As Long
Dim xlFilterRow As Range
Dim lTargetCounts As Long
Dim lTargetRows() As Long
Dim lCount As Long
Dim i As Long

With ThisWorkbook.Worksheets(TARGET_SHEET_NAME)
'オートフィルタの設定状態
If .AutoFilterMode = True Then
'オートフィルタが設定済みなら、一旦解除
.AutoFilter.Range.AutoFilter
End If

'オートフィルタのヘッダとなる行を取得
If .Cells(1, SOURCE_COL).Value <> "" Then
lHeaderRow = 1
Else
lHeaderRow = .Cells(1, SOURCE_COL).End(xlDown).Row
End If

'指定文字データを抽出
With .Range(.Cells(1, SOURCE_COL), .Cells(.Rows.Count, SOURCE_COL))
'オートフィルタ実行
.AutoFilter Field:=1, Criteria1:=sTarget

'絞り込まれた件数取得(ヘッダー行までの行が含まれているので、その分を補正)
lTargetCounts = .CurrentRegion.Resize(, 1).SpecialCells(xlVisible).Count - lHeaderRow

If lTargetCounts > 0 Then
'対象の行を格納する配列初期化
ReDim lTargetRows(lTargetCounts - 1)

For Each xlFilterRow In .CurrentRegion.Resize(, 1).SpecialCells(xlVisible)
'対象データの行の取得
If xlFilterRow.Row > lHeaderRow Then
'ヘッダー行以降
lTargetRows(lCount) = xlFilterRow.Row

lCount = lCount + 1
End If
Next xlFilterRow
End If
End With

'オートフィルタ解除
.AutoFilter.Range.AutoFilter

If .Cells(lHeaderRow, SOURCE_COL).Value = sTarget Then
ReDim Preserve lTargetRows(lCount)

lTargetRows(lCount) = lHeaderRow

lTargetCounts = lTargetCounts + 1
End If

'データの移動
For i = 0 To lTargetCounts - 1
.Cells(lTargetRows(i), SOURCE_COL).Cut Destination:=.Cells(lTargetRows(i), DEST_COL)
Next i
End With

Debug.Print "Done."

End Sub


実行前にオートフィルタが設定されている場合、オートフィルタは解除されます。
必要であれば、処理を追加すれば元に戻せます。(多分)(未確認)


a-kuma3さんのコメント
ぼくも、ループ回数を削減してみました。 >|vb| Sub copy_cell() word = "りんご" dest_col = 9 ' I列 src_col = 10 ' J列 last_row = Cells(Rows.Count, src_col).End(xlUp).Row Set area = Range(Cells(1, dest_col), Cells(last_row, src_col)) area.AutoFilter Field:=1, Criteria1:="=" area.AutoFilter Field:=2, Criteria1:=word Set area = area.Offset(1, 0).Resize(area.Rows.Count - 1, area.Columns.Count) Set area = area.SpecialCells(xlCellTypeVisible) area.FillLeft area.AutoFilter End Sub ||< 列が隣り合ってるのが幸い。 来週のぼくには、何をやってるのか分からなくなってるな <tt>:-)</tt>

moon-fonduさんのコメント
一瞬で移動できました、ありがとうございました(^^;
関連質問

●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ