Excelで片方の列からもう1つの列へデータを貼り付けていきたい


今、AI列に4行目から6000行ぐらいデータが入っております。
そしてAJ列には、4行目から15万行まで、同じく6000行ほどデータが入っております。

AI列の方は、4行目から6000行目ほどまで、びっしり密にデータが入っていますが。
AJ列の方は、空白セルの行が多く、まばらにデータが入っています。

この状態におきまして。
AI列のデータを4行目から1つずつ、空白セルを無視しながら、AJ列のセルへ上から(4行目から)上書きしたいのです。

AJ列のセルのデータの個数、AI列のセルのデータの個数も、ほぼ同じなので。
うまくAJ列のデータをAI列へ、全て上書きできますと助かります。
AJ列のデータは無くなっても構いません。

よろしくお願い致します。

回答の条件
  • 1人10回まで
  • 登録:
  • 終了:2018/03/13 05:08:42
※ 有料アンケート・ポイント付き質問機能は2023年2月28日に終了しました。

ベストアンサー

id:Z1000S No.3

回答回数39ベストアンサー獲得回数27

ポイント600pt

VBAでも良いのであれば、こんな感じでしょうか。

Public Sub transferAI2AJ()

Const TARGET_SHEET_NAME As String = "Sheet1"

'コピー元列(AI)
Const SOURCE_COL As Long = 35

'コピー先列(AJ)
Const DEST_COL As Long = 36

Const BEGIN_ROW As Long = 4

Dim lCurrentRowAI As Long
Dim lCurrentRowAJ As Long
Dim lBeginRow As Long
Dim lEndRowAI As Long
Dim lEndRowAJ As Long
Dim lTermRowAJ As Long
Dim lTargetCount As Long

lCurrentRowAI = BEGIN_ROW
lCurrentRowAJ = BEGIN_ROW

With ThisWorkbook.Worksheets(TARGET_SHEET_NAME)
' .EnableCalculation = False

'AI列の最終行
lEndRowAI = .Cells(.Rows.Count, SOURCE_COL).End(xlUp).Row

'AJ列の最終行
lEndRowAJ = .Cells(.Rows.Count, DEST_COL).End(xlUp).Row

Do
If .Cells(lCurrentRowAJ, DEST_COL).Value <> "" Then
'AJ列にデータが有る
If .Cells(lCurrentRowAJ + 1, DEST_COL).Value <> "" Then
'次の行にデータが有れば、連続する終端行を取得
lTermRowAJ = .Cells(lCurrentRowAJ, DEST_COL).End(xlDown).Row
Else
'次の行にデータがなければ、この行が終端行
lTermRowAJ = lCurrentRowAJ
End If

'コピーする行数
lTargetCount = lTermRowAJ - lCurrentRowAJ + 1

'AI列の最終データ行を超える場合、コピーする行数と最終行を補正する
If lCurrentRowAI + lTargetCount - 1 > lEndRowAI Then
lTargetCount = lEndRowAI - lCurrentRowAI + 1
lTermRowAJ = lCurrentRowAJ + lTargetCount - 1
End If

'AI列からAJ列にコピー
.Range(.Cells(lCurrentRowAI, SOURCE_COL), .Cells(lCurrentRowAI + lTargetCount - 1, SOURCE_COL)).Copy .Cells(lCurrentRowAJ, DEST_COL)

'AI、AJ各列の次の基準行を設定
lCurrentRowAI = lCurrentRowAI + lTargetCount
lCurrentRowAJ = .Cells(lTermRowAJ, DEST_COL).End(xlDown).Row
Else
'AJ列にデータがない
'AJ列の基準行を設定
lCurrentRowAJ = .Cells(lCurrentRowAJ, DEST_COL).End(xlDown).Row
End If
Loop Until (lCurrentRowAJ > lEndRowAJ) Or (lCurrentRowAI > lEndRowAI)

' .EnableCalculation = True
End With

Debug.Print "Done."

End Sub


EnableCalculation のコメント化(2箇所)は、必要であれば解除していただければよろしいかと。

id:moon-fondu

すごいです、うまく変換できました!

2018/03/13 04:17:59

その他の回答2件)

id:segavvy No.1

回答回数12ベストアンサー獲得回数5

ポイント500pt

次の手順でいかがでしょうか。

1)作業用として、AJ列の右に1列挿入してください。ここがAK列になります。

2)セル[AK4]に次の式を入れます。
=IF(AJ4<>"",INDEX(AI$4:AI$6000,COUNTA(AJ$4:AJ4),1),"")

3)セル[AK4]を選択してコピーし、AK5~AK150000まで式として貼り付けてください。これでAK列の内容が、AJ列に上書きしたいものになるかと思います。

4)AK列をコピーして、AJ列へ値として貼り付けてください。

5)作業用に作ったAK列を削除してください。

id:moon-fondu

ありがとうございます、うまくいきました!

2018/03/13 04:17:37
id:Asayuri No.2

回答回数309ベストアンサー獲得回数65

ポイント50pt

 
参考のエクセルファイルを作成してみましたので

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

http://xfs.jp/M3X4nY
 
着色したセルに関数式が入れてあります
 
AL列をコピーして AJ列に値貼り付けすれば ご希望のデータが出来上がります
 
よろしくお願いします
 

id:moon-fondu

ありがとうございます!
AsayuriさんのファイルのAI列に私のファイルのAI列のデータ、AJ列に、私のファイルのAJ列のデータ(まばらなもの)を貼り付けてみました。
AL列に変換結果が出てきているのですが、なぜか4行目と25行目、2個しか出てきていないのです・・・

2018/03/13 04:05:30
id:Z1000S No.3

回答回数39ベストアンサー獲得回数27ここでベストアンサー

ポイント600pt

VBAでも良いのであれば、こんな感じでしょうか。

Public Sub transferAI2AJ()

Const TARGET_SHEET_NAME As String = "Sheet1"

'コピー元列(AI)
Const SOURCE_COL As Long = 35

'コピー先列(AJ)
Const DEST_COL As Long = 36

Const BEGIN_ROW As Long = 4

Dim lCurrentRowAI As Long
Dim lCurrentRowAJ As Long
Dim lBeginRow As Long
Dim lEndRowAI As Long
Dim lEndRowAJ As Long
Dim lTermRowAJ As Long
Dim lTargetCount As Long

lCurrentRowAI = BEGIN_ROW
lCurrentRowAJ = BEGIN_ROW

With ThisWorkbook.Worksheets(TARGET_SHEET_NAME)
' .EnableCalculation = False

'AI列の最終行
lEndRowAI = .Cells(.Rows.Count, SOURCE_COL).End(xlUp).Row

'AJ列の最終行
lEndRowAJ = .Cells(.Rows.Count, DEST_COL).End(xlUp).Row

Do
If .Cells(lCurrentRowAJ, DEST_COL).Value <> "" Then
'AJ列にデータが有る
If .Cells(lCurrentRowAJ + 1, DEST_COL).Value <> "" Then
'次の行にデータが有れば、連続する終端行を取得
lTermRowAJ = .Cells(lCurrentRowAJ, DEST_COL).End(xlDown).Row
Else
'次の行にデータがなければ、この行が終端行
lTermRowAJ = lCurrentRowAJ
End If

'コピーする行数
lTargetCount = lTermRowAJ - lCurrentRowAJ + 1

'AI列の最終データ行を超える場合、コピーする行数と最終行を補正する
If lCurrentRowAI + lTargetCount - 1 > lEndRowAI Then
lTargetCount = lEndRowAI - lCurrentRowAI + 1
lTermRowAJ = lCurrentRowAJ + lTargetCount - 1
End If

'AI列からAJ列にコピー
.Range(.Cells(lCurrentRowAI, SOURCE_COL), .Cells(lCurrentRowAI + lTargetCount - 1, SOURCE_COL)).Copy .Cells(lCurrentRowAJ, DEST_COL)

'AI、AJ各列の次の基準行を設定
lCurrentRowAI = lCurrentRowAI + lTargetCount
lCurrentRowAJ = .Cells(lTermRowAJ, DEST_COL).End(xlDown).Row
Else
'AJ列にデータがない
'AJ列の基準行を設定
lCurrentRowAJ = .Cells(lCurrentRowAJ, DEST_COL).End(xlDown).Row
End If
Loop Until (lCurrentRowAJ > lEndRowAJ) Or (lCurrentRowAI > lEndRowAI)

' .EnableCalculation = True
End With

Debug.Print "Done."

End Sub


EnableCalculation のコメント化(2箇所)は、必要であれば解除していただければよろしいかと。

id:moon-fondu

すごいです、うまく変換できました!

2018/03/13 04:17:59

コメントはまだありません

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

回答リクエストを送信したユーザーはいません