| |
こんにちは。かみちゃん です。
>>「所有者情報」というのが「数万行のデータが並ぶシート」だと思いますが、
>>これが複数あるのですか？
>
>はい、その対象地域が違いますので
>「所有者情報」は複数のExcelシートがありますし、
>そのそれぞれが数万件のデータが記載されています。
>よって別シートに必要な２つの列をコピーして
>作業を行いたいと思っております。
>
>>この店は、了解しましたが、万が一、A列に値がない場合は、
>>「−こ」というような出力結果になってもよいということでよろしいでしょうか？
>
>別シート
> A B C
>1 あ か あ−か
>2 い き い−き
>3 う く う−く
>4 え え
>5 こ
>
>上記でいうとA列の最終行は４行目ですから、
>B列の行がA列以上の行になることは絶対にありません。
>つまり、B列は４行目までになります。
4行目までの間のA列に値がない場合が万が一あった場合は、
「−こ」というような出力結果になってもよいということであれば、以下のような感じでできると思います。
なお、マクロを実行すると、1列目と2列目の選択を求める表示が出ますので、
その時点で、転記元の列のセルを1列ずつ選択してください。
Sub Sample()
Dim rng1 As Range
Dim rng2 As Range
Dim rng3 As Range
Dim i As Long
Dim v1 As Variant
Dim v2 As Variant
Dim vntResult As Variant
Dim lngRow As Long
' Dim lngColumn As Long
Dim lngMaxRow As Long
For i = 1 To 2
On Error Resume Next
Set rng2 = Application.InputBox(i & "列目のセルを選択してください", Type:=8)
On Error GoTo 0
If rng2 Is Nothing Then
MsgBox i & "列目の選択をキャンセしました"
Exit Sub
End If
If rng2.Columns.Count > 1 Then
MsgBox i & "列目が複数列選択されていますので、処理を中止します"
Exit Sub
End If
If i = 1 Then
Set rng1 = rng2
With rng1
lngMaxRow = .Offset(.Parent.Rows.Count - .Row).End(xlUp).Row
End With
End If
Next
v1 = rng1.EntireColumn.Cells(1, 1).Resize(lngMaxRow).Value
v2 = rng2.EntireColumn.Cells(1, 1).Resize(lngMaxRow).Value
ReDim vntResult(1 To lngMaxRow, 1 To 3)
For lngRow = 1 To lngMaxRow
vntResult(lngRow, 1) = v1(lngRow, 1)
vntResult(lngRow, 2) = v2(lngRow, 1)
vntResult(lngRow, 3) = v1(lngRow, 1)
If v2(lngRow, 1) <> "" Then
vntResult(lngRow, 3) = vntResult(lngRow, 3) & "−" & v2(lngRow, 1)
End If
Next
With Sheets("Sheet2").Range("A1")
Set rng3 = .Offset(.Parent.Rows.Count - .Row).End(xlUp)
End With
If rng3.Value <> "" Then
Set rng3 = rng3.Offset(1)
End If
rng3.Resize(lngMaxRow, 3).Value = vntResult
End Sub
Excel2002で動作確認してあります。
|
|
かみちゃん
- 10/1/10(日) 15:12 -
