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

2つのブック間の列を2行目から比較して、完全一致したら、片方のブックの指定のセルをコピーして、片方のブックの指定のセルに貼り付けたい

Excelの質問です。
今、ブックAのAO列に、空白セルを含め、

2|(空白セル)
3|あいうえお
4|かきくけこ
5|さしすせそ
6|(空白セル)
7|なにぬねの




と、データが6万行ほど並んでおります。
そしてブックBのG列には、

2|(空白セル)
3|あいうえお
4|たちつてと
5|なにぬねの
6|(空白セル)
7|かきくけこ




と、データが並んでおります。
この状況におきまして、ブックA・AO列のデータが入った文字列(?)を、ブックB・G列にて、1つずつ検索しまして。

完全一致で見つかりましたら、その一致した文字列(?)のあるセルから右に10、上に1つ移動したセル(?)をコピーしまして。

ブックAの?から左に7、上に1移動したセルに、?のデータを貼り付けたいのです。

数が多くありますして、効率的に貼り付けできたらと思いまして…。
ブックA、ブックBともに、同じ列内には重複データはおそらく1つもありません。

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

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

▽最新の回答へ

質問者から

上記の例ですと、上から貼り付けするとしまして、空白セルは無視するので、

・ブックA・AO3:あいうえお→ブックB・G3にあり→右に10、上に1移動した【Q2セル】をコピー→ブックA・AO3から左に7、上に1移動した【AH2セル】に貼り付け
・ブックA・AO4:かきくけこ→ブックB・G7にあり→右に10、上に1移動した【Q6セル】をコピー→ブックA・AO4から左に7、上に1移動した【AH3セル】に貼り付け


といった感じで6万行ほど貼り付けていきたいです。

お手数お掛け致しますが、よろしくお願いします。


1 ● Asayuri
●50ポイント

「完全一致で見つかりましたら、その一致した文字列(?)のあるセルから右に10
上に1つ移動したセル(?)をコピーしまして」とは
?は どこにあるデータのことを指しているのか
?は 何を 移動したセルなのか
「移動した」セルの意味は その位置にもともとあるデータのことなのか
貴殿の文章表現からは 読み取ることはできません
もう一度 文章を 再考願います


moon-fonduさんのコメント
?は、ブックBのG列になりまして。 ?は、指定の文字列にヒットした文字列のことで、その文字列のセルを起点として、右に10、上に1つ移動したセルをコピーできれば、と思いました。 判りにくくてすみません…<m(__)m>

2 ● chamco
●750ポイント

リスト?とリスト?が1行ずれているのがややこしいですね。
リスト?を1行さげられればVLOOKUP関数でシンプルにできそうですが。

検討違いだったらすみませんが、以下の方法は使えますでしょうか?

説明しやすいように仮に対象範囲を以下とします。
リスト?→ブックA セル範囲AO3?AO60000
リスト?→ブックB セル範囲G3?G60000
リスト?→ブックB セル範囲Q2?Q59999 …リスト?の10列右&1行上
貼付先→ブックA セル範囲AH2?AH59999 …リスト?の7列左&1行上

ブックAの貼付先先頭セルAH2に以下の通り関数を入れて下さい。

=INDEX(リスト?全範囲,MATCH( リスト?検索文字列セル,リスト?全範囲,0),1)
↓上で設定したセル範囲を反映させると、実際は下のような式になるかと思います。
=INDEX('[ブックB.xls]シート名'!$Q$2:$Q$59999,MATCH(AO3,'[ブックB.xls]シート名'!$G$3:$G$60000,0),1)

あとはコピペすれば、一致したものについて読み込まれるかと思います。

また、このままだと空白があるところは#N/A(エラー)で表示されます。
#N/Aではなく空白を返したい場合は以下の通りIF関数などで対処して下さい。

=IF(AO3="","",上の式)
↓これも実際は下のような式
=IF(AO3="","",INDEX('[ブックB.xls]シート名'!$Q$2:$Q$59999,MATCH(AO3,'[ブックB.xls]シート名'!$G$3:$G$60000,0),1))

分かりづらいかもしれませんが、よろしくお願いします。


moon-fonduさんのコメント
いやーすごいです、関数で出来るんですね! ありがとうございます(^^♪

3 ● Z1000S
●1200ポイント ベストアンサー

「Microsoft Scripting Runtime」を参照設定をするのと、
SOURCE_FILE_PATHのパスを修正してから実行して下さい。

ブックA、ブックBともに、同じ列内には重複データはおそらく1つもありません。

重複データが有る時は、後から出てきたデータ(下の方に有るデータ)が表示されます。

'参照設定: Microsoft Scripting Runtime

'---------- 自ワークシート関連 ----------
Private Const KEY_ITEM_SHEET_NAME As String = "Sheet1"

'検索基準キーとなるデータ列
Private Const KEY_ITEM_COL As String = "AO"

'データ開始行
Private Const KEY_ITEM_BEGIN_ROW As Long = 2

'基準セルから書き込みするセルへのオフセット
Private Const COL_OFFSET_DEST_CELL As Long = -7
Private Const ROW_OFFSET_DEST_CELL As Long = -1


'---------- 参照先ワークシート関連 ----------
'参照するブックのフルパス
Private Const SOURCE_FILE_PATH As String = "C:\Datas\ブックB.xlsx"

Private Const SOURCE_SHEET_NAME As String = "Sheet1"

'参照する列
Private Const SOURCE_COL As String = "G"

'データ開始行
Private Const SOURCE_BEGIN_ROW As Long = 2

'基準セルから読み込みするセルへのオフセット
Private Const COL_OFFSET_SRC_CELL As Long = 10
Private Const ROW_OFFSET_SRC_CELL As Long = -1


Public Sub copyItemsSubValue()

 Dim wsOwn As Worksheet
 Dim lEndRow As Long
 Dim lCurrentRow As Long
 Dim sKeyValue As String
 Dim lKeyItemCol As Long
 Dim lResult As Long
 Dim dicSrc As New Dictionary

 Call addDictionary(dicSrc)

  '出力先ワークシートの取得
 Set wsOwn = ThisWorkbook.Worksheets(KEY_ITEM_SHEET_NAME)

 lKeyItemCol = wsOwn.Columns(KEY_ITEM_COL).Column

  'キーデータ列の最終行取得
 lEndRow = wsOwn.Cells(wsOwn.Rows.Count, lKeyItemCol).End(xlUp).Row

 With wsOwn
 For lCurrentRow = KEY_ITEM_BEGIN_ROW To lEndRow
  'キーの値を取得
 sKeyValue = .Cells(lCurrentRow, lKeyItemCol).Value

 If Len(sKeyValue) > 0 Then
 If dicSrc.Exists(sKeyValue) Then
 .Cells(lCurrentRow, lKeyItemCol).Offset(ROW_OFFSET_DEST_CELL, COL_OFFSET_DEST_CELL).Value = dicSrc.Item(sKeyValue)
 End If
 End If
 Next lCurrentRow
 End With

PostProcessing:
 If Err.Number <> 0 Then
 Debug.Print CStr(Err.Number) & Err.Description
 End If

 Set wsOwn = Nothing

 Debug.Print "Done."

End Sub

Private Sub addDictionary(ByRef dicSrc As Dictionary)

 Dim wbSrc As Workbook
 Dim wsSrc As Worksheet
 Dim lSrcCol As Long
 Dim lLastRow As Long
 Dim i As Long
 Dim sKey As String
 Dim sValue As String
 Dim lCol As Long

 On Error GoTo PostProcessing

  '参照先ワークシートの取得
 Set wbSrc = Workbooks.Open(SOURCE_FILE_PATH, ReadOnly:=True)
 Set wsSrc = wbSrc.Worksheets(SOURCE_SHEET_NAME)

 lCol = wsSrc.Columns("G").Column

 lLastRow = wsSrc.Cells(wsSrc.Rows.Count, lCol).End(xlUp).Row

 For i = SOURCE_BEGIN_ROW To lLastRow
 sKey = wsSrc.Cells(i, lCol).Value

 If Len(sKey) > 0 Then
 dicSrc(sKey) = wsSrc.Cells(i, lCol).Offset(ROW_OFFSET_SRC_CELL, COL_OFFSET_SRC_CELL).Value
 End If
 Next i

PostProcessing:
 If Err.Number <> 0 Then
 Debug.Print CStr(Err.Number) & ":" & Err.Description
 End If

 If Not wbSrc Is Nothing Then
 If Not wsSrc Is Nothing Then
 Set wsSrc = Nothing
 End If

 wbSrc.Close SaveChanges:=False

 Set wbSrc = Nothing
 End If

End Sub

moon-fonduさんのコメント
すごいです・・・変換できました! ありがとうございます(^^♪

Z1000Sさんのコメント
ベストアンサーありがとうございます。
関連質問

●質問をもっと探す●



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